input from barcode scanner

wade0119

New Member
Joined
Dec 21, 2015
Messages
8
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.
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Try This.

Code:
[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]
 
Last edited:
Upvote 0
Here is one way.

Copy to the sheet module.

Scan into cell A1.

Howard

Code:
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
 
Upvote 0
Here is one way.

Copy to the sheet module.

Scan into cell A1.

Howard

Code:
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.
 
Upvote 0
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.

Code:
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
 
Upvote 0
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

Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,916
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top