Badge Scanning Tool - Need help resetting

M

mlathem1998

New Member
Joined
Feb 11, 2021
Messages
27
Office Version
  1. 365
Platform
  1. Windows
I had a tool built years back that would allow me to scan badges, then do a vlookup for the associated employee ID, and it time and date stamp the entry. After that pop down to the next line. The first tab is a scanning page with a button to launch the scanning tool, but it is also set to auto load when you open the file. There is a form control has a text box and clear list button. When you scan a badge with the right number of characters, it executes the vba code to find the employee number and drop it in A2. However, I can't get this to reset and it keeps popping up every time after the last entry even after I clear the list. So, I scan a badge, the next cell would be 430, then when I clear the list, it SHOULD go right back to A2. .




1613092571562.png



Sub Clean_List()
'
' Clean_List Macro
'

'
Columns("A:B").Select
ActiveSheet.Range("$A$1:$B$800").RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlYes

End Sub



Private Sub CommandButton1_Click()
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Range("A1").Value = "EMPLOYEE ID"
Range("B1").Value = "SCANNED DATE"
TextBox1.SetFocus
Range("A2").Select
End Sub

Private Sub TextBox1_AfterUpdate()

End Sub

Private Sub TextBox1_Change()
If Len(Trim(TextBox1.Text)) = 8 Or TextBox1.Text = "" Then
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, -1).Select
ActiveCell.Value = TextBox1.Value
TextBox1.Text = ""
ActiveCell.Offset(-1, 1).Value = DateTime.Now


End If

End Sub



Can anyone help me figure out how to fix this? I know nothing about VBA really.


1613092754529.png
 
Sort by date Sort by votes
Here is the code used:

Private Sub TextBox1_Change()
Dim LastRow As Long
If Len(Trim(TextBox1.Text)) = 6 Or TextBox1.Text = "" Then
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
With Sheets("Scan List")
.Cells(LastRow + 1, 1) = TextBox1
.Cells(LastRow + 1, 2) = Now
End With
End If
TextBox1.Text = ""
End Sub

Private Sub CommandButton1_Click()
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
With Sheets("Scan List")
.Range(.Cells(2, 1), .Cells(LastRow, 2)).ClearContents
End With
End Sub
 
Upvote 0

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
I screwed that up didn't I, this should do it
VBA Code: 
Private Sub TextBox1_Change()
    Dim LastRow As Long
    If Me.TextBox1 = "" Then Exit Sub
    If Len(Trim(TextBox1.Text)) = 6 Then
        LastRow = Cells(Rows.Count, "A").End(xlUp).Row
        With Sheets("Scan List")
            .Cells(LastRow + 1, 1) = TextBox1
            .Cells(LastRow + 1, 2) = Now
        End With
        TextBox1.Text = ""
    End If
End Sub
 
Upvote 0
Solution
Yes... thank you so much. That finally got mt much closer to what I need. That dang VBA coding is just something I will never understand.
 
Upvote 0
Well, I did find a little hiccup maybe you can help with. The numbers get scanned in as text and I need them as numbers for the vlookup to work right. I've tried converting the whole row to number, but it keeps scanning as text. Any ideas how to change the input from text to number?
 
Upvote 0
Try
VBA Code: 
 .Cells(LastRow + 1, 1) = TextBox1.Value
 
Upvote 0
I believe what you've asked in your other thread can be addressed here at the same time you write the scan and timestamp to the sheet eliminating most of what you're asking over there.

If you want to include the employee name and # when writing the badge and timestamp to the sheet, try this.
Not knowing the layout of the Employee_List sheet, I used the Employee_List_Badge sheet as the employee list (only 3 of them) so you can see how it would work.
VBA Code: 
Private Sub TextBox1_Change()

Dim fndRng As Range, nextrow As Long

' only deal with things if 6 characters
If Len(Trim(TextBox1.Text)) <> 6 Then
    Exit Sub
Else
    ' find badge number in employee list
    With Sheets("Employee_List_Badge").Range("B:B")
        Set fndRng = .Find(What:=Me.TextBox1.Value, LookIn:=xlValues, _
                           LookAt:=xlWhole, SearchOrder:=xlByRows, _
                           SearchDirection:=xlNext, MatchCase:=False)
    End With
    If Not fndRng Is Nothing Then   ' the number is found, so work from there for name and #
        With Sheets("Scan List")
            nextrow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            .Range("A" & nextrow) = fndRng.Value                    ' badge number
            .Range("B" & nextrow) = fndRng.Offset(, 1).Value        ' employee number
            .Range("C" & nextrow) = fndRng.Offset(, -1).Value       ' employee name
            .Range("D" & nextrow) = Now                             ' time stamp
        End With
        ' clear the text box
        TextBox1.Text = ""
        Exit Sub
    Else    ' the number isn't found
        MsgBox Me.TextBox1.Value & " was not found"
        ' clear the text box
        TextBox1.Text = ""
    End If
End If
End Sub

you can download my test file here for your examination.
 
Upvote 0
NoSparks said:
I believe what you've asked in your other thread can be addressed here at the same time you write the scan and timestamp to the sheet eliminating most of what you're asking over there.

If you want to include the employee name and # when writing the badge and timestamp to the sheet, try this.
Not knowing the layout of the Employee_List sheet, I used the Employee_List_Badge sheet as the employee list (only 3 of them) so you can see how it would work.
VBA Code: 
Private Sub TextBox1_Change()

Dim fndRng As Range, nextrow As Long

' only deal with things if 6 characters
If Len(Trim(TextBox1.Text)) <> 6 Then
    Exit Sub
Else
    ' find badge number in employee list
    With Sheets("Employee_List_Badge").Range("B:B")
        Set fndRng = .Find(What:=Me.TextBox1.Value, LookIn:=xlValues, _
                           LookAt:=xlWhole, SearchOrder:=xlByRows, _
                           SearchDirection:=xlNext, MatchCase:=False)
    End With
    If Not fndRng Is Nothing Then   ' the number is found, so work from there for name and #
        With Sheets("Scan List")
            nextrow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            .Range("A" & nextrow) = fndRng.Value                    ' badge number
            .Range("B" & nextrow) = fndRng.Offset(, 1).Value        ' employee number
            .Range("C" & nextrow) = fndRng.Offset(, -1).Value       ' employee name
            .Range("D" & nextrow) = Now                             ' time stamp
        End With
        ' clear the text box
        TextBox1.Text = ""
        Exit Sub
    Else    ' the number isn't found
        MsgBox Me.TextBox1.Value & " was not found"
        ' clear the text box
        TextBox1.Text = ""
    End If
End If
End Sub

you can download my test file here for your examination.
Click to expand...
Thank you thank you so much!!!

Almost there now. Have a few more tweaks needed.

First I'd like to see if possible to show status of scan down the whole employee list. This is the Employee List Badge and I want to add column D to show Yes or No status based off the actual scan list. This formula was from the previous file and that is what was used before. This same formula runs down the whole list of employees.

1613919542004.png



Then secondly, how do I make it so I can click on the other excel tabs even when the scan tool is open. Currently when the scan tool is open and you click on any other areas outside the scan tool it gives you an alert and you can't do anything until you close the scan tool.

1613919752029.png
 

Attachments

  • 1613917422825.png
    1613917422825.png
    13 KB · Views: 5
  • 1613917674920.png
    1613917674920.png
    5.2 KB · Views: 6
  • 1613919364546.png
    1613919364546.png
    8.5 KB · Views: 7
Upvote 0
First I'd like to see if possible to show status of scan down the whole employee list. This is the Employee List Badge and I want to add column D to show Yes or No status based off the actual scan list. This formula was from the previous file and that is what was used before. This same formula runs down the whole list of employees.
Click to expand...
I'm no good with formulas so the way I'd approach this is at the time of the badge scan also write the timestamp into column E of Employee_List_Badge (which could be hidden) so only need a simple formula in column D. Column E would then be cleared with the form Clear List button at the same time as the Scan List.
Maybe formula in D4 =IF(E4<>"",IF(INT(E4)=TODAY(),"YES","NO"),"NO")
(This makes me wonder, is your Scan List actually necessary?)

Then secondly, how do I make it so I can click on the other excel tabs even when the scan tool is open. Currently when the scan tool is open and you click on any other areas outside the scan tool it gives you an alert and you can't do anything until you close the scan tool.
Click to expand...
By default user forms are Modal so you will need to change it to Modeless.
See an explanation and how to here
Do some testing to see where the scanner scan goes if/when the form is not active at the time of the scan.

There are issues making the user form text box have the cursor when the form is 'brought back to life'
have tried to overcome this with the UserForm_Click event

Here is the entire code as I now have it in the form module
VBA Code: 
Option Explicit
'
' https://www.mrexcel.com/board/threads/badge-scanning-tool-need-help-resetting.1161526/
'


Private Sub CommandButton1_Click()
    ' button to clear list
    Dim LastRow As Long
    With Sheets("Scan List")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastRow = Application.Max(LastRow, 3)
        .Range(.Cells(3, 1), .Cells(LastRow, 4)).ClearContents
    End With
    With Sheets("Employee_List_Badge")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("E4:E" & LastRow).ClearContents
    End With
    
    Me.TextBox1.SetFocus
End Sub


Private Sub TextBox1_Change()

Dim fndRng As Range, nextrow As Long

' only deal with things if 6 characters
If Len(Trim(TextBox1.Text)) <> 6 Then
    Exit Sub
Else
    ' find badge number in employee list
    With Sheets("Employee_List_Badge").Range("B:B")
        Set fndRng = .Find(What:=Me.TextBox1.Value, LookIn:=xlValues, _
                           LookAt:=xlWhole, SearchOrder:=xlByRows, _
                           SearchDirection:=xlNext, MatchCase:=False)
    End With
    If Not fndRng Is Nothing Then   ' the number is found
        
        ' this is for info only, remove it after testing
        'MsgBox Me.TextBox1.Value & " found at cell " & fndRng.Address(False, False) & " in the Employees"
        ''''''
        ' timestamp on Employee_List_Badge sheet
        fndRng.Offset(, 3) = Now
        
        With Sheets("Scan List")
            nextrow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            .Range("A" & nextrow) = fndRng.Value                    ' badge number
            .Range("B" & nextrow) = fndRng.Offset(, 1).Value        ' employee number
            .Range("C" & nextrow) = fndRng.Offset(, -1).Value       ' employee name
            .Range("D" & nextrow) = Now                             ' time stamp
        End With
        ' clear the text box
        TextBox1.Text = ""
        Exit Sub
    Else    ' the number isn't found
        MsgBox Me.TextBox1.Value & " was not found"
        ' leave non valid scan for examination, but ready to be overwritten
        With Me.TextBox1
            .SelStart = 0
            .SelLength = Len(.Text)
            .Visible = False
            .Visible = True
            .SetFocus
        End With
    End If
End If
End Sub

Private Sub UserForm_Click()
    With Me.TextBox1
        .Visible = False
        .Visible = True
        .SetFocus
    End With
End Sub

Good luck with your project.
 
Upvote 0
NoSparks said:
I'm no good with formulas so the way I'd approach this is at the time of the badge scan also write the timestamp into column E of Employee_List_Badge (which could be hidden) so only need a simple formula in column D. Column E would then be cleared with the form Clear List button at the same time as the Scan List.
Maybe formula in D4 =IF(E4<>"",IF(INT(E4)=TODAY(),"YES","NO"),"NO")
(This makes me wonder, is your Scan List actually necessary?)


By default user forms are Modal so you will need to change it to Modeless.
See an explanation and how to here
Do some testing to see where the scanner scan goes if/when the form is not active at the time of the scan.

There are issues making the user form text box have the cursor when the form is 'brought back to life'
have tried to overcome this with the UserForm_Click event

Here is the entire code as I now have it in the form module
VBA Code: 
Option Explicit
'
' https://www.mrexcel.com/board/threads/badge-scanning-tool-need-help-resetting.1161526/
'


Private Sub CommandButton1_Click()
    ' button to clear list
    Dim LastRow As Long
    With Sheets("Scan List")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastRow = Application.Max(LastRow, 3)
        .Range(.Cells(3, 1), .Cells(LastRow, 4)).ClearContents
    End With
    With Sheets("Employee_List_Badge")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("E4:E" & LastRow).ClearContents
    End With
   
    Me.TextBox1.SetFocus
End Sub


Private Sub TextBox1_Change()

Dim fndRng As Range, nextrow As Long

' only deal with things if 6 characters
If Len(Trim(TextBox1.Text)) <> 6 Then
    Exit Sub
Else
    ' find badge number in employee list
    With Sheets("Employee_List_Badge").Range("B:B")
        Set fndRng = .Find(What:=Me.TextBox1.Value, LookIn:=xlValues, _
                           LookAt:=xlWhole, SearchOrder:=xlByRows, _
                           SearchDirection:=xlNext, MatchCase:=False)
    End With
    If Not fndRng Is Nothing Then   ' the number is found
       
        ' this is for info only, remove it after testing
        'MsgBox Me.TextBox1.Value & " found at cell " & fndRng.Address(False, False) & " in the Employees"
        ''''''
        ' timestamp on Employee_List_Badge sheet
        fndRng.Offset(, 3) = Now
       
        With Sheets("Scan List")
            nextrow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            .Range("A" & nextrow) = fndRng.Value                    ' badge number
            .Range("B" & nextrow) = fndRng.Offset(, 1).Value        ' employee number
            .Range("C" & nextrow) = fndRng.Offset(, -1).Value       ' employee name
            .Range("D" & nextrow) = Now                             ' time stamp
        End With
        ' clear the text box
        TextBox1.Text = ""
        Exit Sub
    Else    ' the number isn't found
        MsgBox Me.TextBox1.Value & " was not found"
        ' leave non valid scan for examination, but ready to be overwritten
        With Me.TextBox1
            .SelStart = 0
            .SelLength = Len(.Text)
            .Visible = False
            .Visible = True
            .SetFocus
        End With
    End If
End If
End Sub

Private Sub UserForm_Click()
    With Me.TextBox1
        .Visible = False
        .Visible = True
        .SetFocus
    End With
End Sub

Good luck with your project.
Click to expand...
Sorry, been pretty tied up all week.

Using the formula you posted:

=IF(E4<>"",IF(INT(E4)=TODAY(),"YES","NO"),"NO")
But when I clear the list, for some reason it will not clear the top row, but anything else below it will.
1614382370263.png
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Moving cursor to next column
Replies
2
Views
286
Jeffrey Mahoney
Jeffrey Mahoney
E
  • Solved
Userform as search tool
Replies
5
Views
256
Akuini
Akuini
A
  • Solved
Why isn't this code working
Replies
5
Views
304
amoverton2
A
I
  • Solved
Have Listbox show dd/mm/yyy
Replies
2
Views
276
ipbr21054
I
K
  • Solved
Simple implementation question
Replies
5
Views
420
Katolux
K

Forum statistics

Threads
1,214,911
Messages
6,122,192
Members
449,072
Latest member
DW Draft

Share this page

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