input from barcode scanner

[wade0119]

I would like to scan a barcode label and input the value into cell A1. this input will be a 9 digit unique number. I would like to find the matching value in column B (about 9000 entries already entered) and highlight the row the matching value is found in. then, automatically return to cell A1 for the next input from the barcode scanner. Any help would be greatly appreciated.

 

[lhartono]

Try This.

[COLOR=#d3d3d3]'
'Freeze row 3[/COLOR]
[COLOR=#0000cd]Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR=#d3d3d3]by lhartono @ mrexcel.com[/COLOR][COLOR=#0000cd]
[/COLOR]Const BarCodes = "$B$3:$B$9002"
Dim idx as long

Application.EnableEvents = False

Range("A1").Activate

If (Target.Column = 1) And (Len(Target) = 9) Then
    On Error Resume Next
    idx = (Excel.WorksheetFunction.Match(Target.Value2, Range(BarCodes), 0)) + 2
    
    If Err Then
        Err.Clear
        idx = 0
        MsgBox "    No Match Found.    ", vbCritical, "Info"
    End If
    
    If idx > 0 Then
    
        Application.ScreenUpdating = False
        ActiveWindow.SmallScroll Up:=9100
[/COLOR][COLOR=#a9a9a9]        'With Rows("1:9100").Interior
        '    .Pattern = xlNone
        '    .TintAndShade = 0
        '    .PatternTintAndShade = 0
        'End With[/COLOR][COLOR=#0000cd]
        Application.ScreenUpdating = True
        
        If idx > 3 Then
            ActiveWindow.SmallScroll Down:=(idx - 3)
        End If
        
        Rows(idx & ":" & idx).Interior.Color = vbYellow
        
    End If
End If

Application.EnableEvents = True

End Sub
[/COLOR][COLOR=#d3d3d3]'[/COLOR]

 

[L. Howard]

Here is one way.

Copy to the sheet module.

Scan into cell A1.

Howard

Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Count > 1 Then Exit Sub
If Target <> Range("A1") Then Exit Sub


Dim rngFound As Range, rngA As Range
Dim myFnd As String
Dim lr As Long


myFnd = Sheets("Sheet7").Range("A1")


lr = Cells(Rows.Count, "A").End(xlUp).Row


Set rngFound = Sheets("Sheet7").Range("A2:A" & lr).Find(What:=myFnd, _
                                               LookIn:=xlValues, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)
                                               
If Not rngFound Is Nothing Then
  rngFound.EntireRow.Interior.ColorIndex = 6
  [A1].Activate
Else
    MsgBox "No match found. "
End If
End Sub

 

[wade0119]

Here is one way.

Copy to the sheet module.

Scan into cell A1.

Howard

Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Count > 1 Then Exit Sub
If Target <> Range("A1") Then Exit Sub


Dim rngFound As Range, rngA As Range
Dim myFnd As String
Dim lr As Long


myFnd = Sheets("Sheet7").Range("A1")


lr = Cells(Rows.Count, "A").End(xlUp).Row


Set rngFound = Sheets("Sheet7").Range("A2:A" & lr).Find(What:=myFnd, _
                                               LookIn:=xlValues, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)
                                               
If Not rngFound Is Nothing Then
  rngFound.EntireRow.Interior.ColorIndex = 6
  [A1].Activate
Else
    MsgBox "No match found. "
End If
End Sub

is there a way to send you the spreadsheet to see what i am doing wrong? not working for me.

 

[L. Howard]

is there a way to send you the spreadsheet to see what i am doing wrong? not working for me.

First change the Sheet7 name in the code to match exactly the sheet name you are using the code on.

myFnd = Sheets("[COLOR=#FF0000]Sheet7[/COLOR]").Range("A1")


lr = Cells(Rows.Count, "A").End(xlUp).Row


Set rngFound = Sheets("[COLOR=#FF0000]Sheet7[/COLOR]").Range("A2:A" & lr).Find(What:=myFnd, _
                                               LookIn:=xlValues, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)

If that does not work for you then use one of the link utilities, like Drop Box, and post a link to your example workbook here. You cannot post attachments in the forum.

Howard

 

[wade0119]

https://onedrive.live.com/edit.aspx...7C!12806&parId=B028C12E2B8C927C!103&app=Excel

 

[L. Howard]

edit delete

 

[wade0119]

https://www.dropbox.com/home/WW?preview=Book1.xlsm

 

[L. Howard]

Okay, I got the workbook.

I cleared this out of cell A1. (which was merged and centered across the sheet).

CORP - *Resident SAP Program Summary Report Excel

I selected column A and UNMERGED all cells.

I copied this code into Sheet1 code module.
Enter something in A1 and it searches for it in column A and, if found, highlights the entire row. It will only find the first occurrence of the A1 search item.

Howard

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub
If Target <> Range("A1") Then Exit Sub

Dim rngFound As Range, rngA As Range
Dim myFnd As String
Dim lr As Long

myFnd = Sheets("Sheet1").Range("A1")

lr = Cells(Rows.Count, "A").End(xlUp).Row

Set rngFound = Sheets("Sheet1").Range("A2:A" & lr).Find(What:=myFnd, _
                                               LookIn:=xlValues, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)
                                               
If Not rngFound Is Nothing Then

  rngFound.EntireRow.Interior.ColorIndex = 3   '/ 4 is blue, 6 is yellow
  [A1].Activate

Else

    MsgBox "No match found. "

End If

End Sub