Find from InputBox, copy row of found cell without using .Select

Question

I have a spreadsheet with over 10000 rows. I need to search it using InputBox (UPC field, input is from a barcode scanner).

I need to copy the row of the found cell, and paste it to another sheet.

This process should loop until the user cancels the InputBox.

I have done this, but it gives me an error on the SelectCells.Select line, but not every time.

Sub Scan()

Do Until IsEmpty(ActiveCell)
    Dim Barcode As Double
    Barcode = InputBox("Scan Barcode")
    Dim ws As Worksheet
    Dim SelectCells As Range
    Dim xcell As Object
    
    Set ws = Worksheets("Sheet1")

    For Each xcell In ws.UsedRange.Cells
        If xcell.Value = Barcode Then
            If SelectCells Is Nothing Then
                Set SelectCells = Range(xcell.Address)
            Else
                Set SelectCells = Union(SelectCells, Range(xcell.Address))
            End If
        End If
    Next

    SelectCells.Select
    Set SelectCells = Nothing
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Copy
    Sheets("Sheet2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
Loop

End Sub

Is the barcode you're looking for in some specific column? And are your barcodes all numeric (you have `Dim Barcode As Double`) ? — Tim Williams, Jul 06 '22 at 23:51
The barcode is scanned in from a barcode reader. When the InputBox is brought up, the scanner inputs the numeric value. The field is too long for integer so I used Dim Barcode As Double. ex. barcode value is 987335567590. The Barcode is in a specific column, yes. I need it to find the cell with the barcode, select the entire line for the selected cell and copy/paste to Sheet2. — Medwards, Jul 07 '22 at 03:39

score 1 · Answer 1 · answered Jul 07 '22 at 06:44

Copy Rows

Option Explicit

Sub Scan()
    
    Const sName As String = "Sheet1"
    Const Header As String = "Barcode"
    
    Const dName As String = "Sheet2"
    Const dFirstCellAddress As String = "A2"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim surg As Range: Set surg = sws.UsedRange
    Dim slCell As Range
    Set slCell = surg.Cells(surg.Rows.Count, surg.Columns.Count)
    Dim shCell As Range
    Set shCell = surg.Find(Header, slCell, xlFormulas, xlWhole, xlByRows)
    
    If shCell Is Nothing Then
        MsgBox "The cell containing the header '" & Header _
            & "' was not found.", vbCritical
        Exit Sub
    End If
    
    Dim sfCol As Long: sfCol = surg.Column
    Dim srg As Range
    Set srg = sws.Range(sws.Cells(shCell.Row + 1, sfCol), slCell)
    
    Dim scColIndex As Long: scColIndex = shCell.Column - sfCol + 1
    Dim scrg As Range: Set scrg = srg.Columns(scColIndex)
    
    Dim SelectedRows As Range
    Dim Barcode As Variant
    Dim srIndex As Variant
    
    Do
        
        Barcode = InputBox("Scan Barcode")
        If Len(CStr(Barcode)) = 0 Then Exit Do
        
        If IsNumeric(Barcode) Then
            srIndex = Application.Match(CDbl(Barcode), scrg, 0)
            If IsNumeric(srIndex) Then
                If SelectedRows Is Nothing Then
                    Set SelectedRows = srg.Rows(srIndex)
                Else
                    Set SelectedRows = Union(SelectedRows, srg.Rows(srIndex))
                End If
            End If
        End If
        
    Loop
    
    If SelectedRows Is Nothing Then
        MsgBox "No scan results.", vbExclamation
        Exit Sub
    End If
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim dfCell As Range: Set dfCell = dws.Range(dFirstCellAddress)
    Dim durg As Range: Set durg = dws.UsedRange
    Dim dlRow As Long: dlRow = durg.Row + durg.Rows.Count - 1
    
    Dim dlCell As Range
    
    If dlRow < dfCell.Row Then
        Set dlCell = dfCell
    Else
        Set dlCell = dws.Cells(dlRow + 1, dfCell.Column)
    End If
    
    SelectedRows.Copy dlCell
    
    MsgBox "Rows copied.", vbInformation
    
End Sub

Thanks for the reply! I've tried it and so far it loops fine, but nothing is copied over. I suspect its not finding the barcode in the table, though tbh I'm having trouble understanding this one. I get the message "No scan results, but I can confirm the barcode is in the sheet. — Medwards, Jul 07 '22 at 16:48
Why don't you share a screenshot of worksheet `Sheet1` that shows the first few rows of the worksheet, the row (1,2,3) and column (A,B,C) headers, and its sekected (tab) name at the bottom? If there is no formatting applied to the cells, if the numbers are aligned to the left, they are formatted as text. Otherwise, they are formatted as numbers. If the code is in another workbook than the workbook containing these worksheets, the code will fail. If you have a title (`Barcode`) above the header (`Barcode`), then the code will find the title and will fail. Is the header even `Barcode`? — VBasic2008, Jul 08 '22 at 05:10

Tim Williams · Answer 2 · 2022-07-07T16:58:54.693

0

You can try something like this:

Sub Scan()
    
    Dim Barcode As String, rngData As Range, m, rngDest As Range
    
   'Column with barcodes
    With Worksheets("Sheet1")
        Set rngData = .Range("D1", .Cells(Rows.Count, "D").End(xlUp))
    End With
    'First paste postion
    Set rngDest = Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1)
    
    Do
        Barcode = InputBox("Scan Barcode")
        If Len(Barcode) = 0 Then Exit Do
        
        'm = Application.Match(Barcode, rngData, 0)      'Barcodes formatted as text
        m = Application.Match(CDbl(Barcode), rngData, 0) 'Barcodes formatted as numbers 
        
        If Not IsError(m) Then
            rngData.Rows(m).EntireRow.Copy rngDest 'copy to Sheet2
            Set rngDest = rngDest.Offset(1)
        Else
            'if no match then what?
            Debug.Print "no match"
        End If
    Loop

End Sub

Depending on how your barcodes are stored (as text, or a numeric values) you may need to use CDbl(Barcode) inside the call to Match()

edited Jul 07 '22 at 16:58

answered Jul 07 '22 at 06:31

Tim Williams

154,628
8
97
125

Thank you for the reply! I can't get it to find the barcode in the sheet. I added a MsgBox after Else to say "No matching barcode information found" and I get that everytime. I may be missing something simple, but the column the barcodes are in is D. – Medwards Jul 07 '22 at 16:49
Are your barcodes on the worksheet stored as text, or as numbers? What's the cell formatting that's applied on column D? – Tim Williams Jul 07 '22 at 16:54
See edits above for ColA >> ColD, and for how to search using Match, depending on whether you're trying to match a number or text. – Tim Williams Jul 07 '22 at 16:59
They are numbers only Ex. Barcode number: 987335567590 – Medwards Jul 07 '22 at 17:07
In that case `m = Application.Match(CDbl(Barcode), rngData, 0)` should work. – Tim Williams Jul 07 '22 at 17:13

Find from InputBox, copy row of found cell without using .Select

2 Answers2

Copy Rows