Excel Macro help please.

[runchie]

I have a RFID card reader that scans a badge an inputs the badge # into a cell then goes to the cell below

I want to make it so whenever a badge is scanned i get the Date and time entered into the cells next to the badge #
then go down to the next badge slot for another entry.

Can anyone help please?

|Badge|Date|Time|
|11111|11.2|1130|

 

[Smitty]

Welcome to the Board!

You could try a Sheet Change event, but there is a good chance that the scan event isn't trapped. If that's the case then you can use COUNT to count the entries in the column, then use the Sheet Calculate event instead. As soon as the number of entries changes the formula will update, causing the code to fire.

Here's some boilerplate Change event code that you can test.

<font face=Calibri><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_Change(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>    <SPAN style="color:#007F00">'   Code goes in the Worksheet specific module</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> rng <SPAN style="color:#00007F">As</SPAN> Range<br>        <SPAN style="color:#007F00">'   Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> rng = Target.Parent.Range("xxx")<br>        <SPAN style="color:#007F00">'   Only look at single cell changes</SPAN><br>            <SPAN style="color:#00007F">If</SPAN> Target.Count > 1 <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>        <SPAN style="color:#007F00">'   Only look at that range</SPAN><br>            <SPAN style="color:#00007F">If</SPAN> Intersect(Target, rng) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>        <SPAN style="color:#007F00">'   Action if Condition(s) are met (do your thing here...)</SPAN><br>            <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

HTH,

 

[runchie]

Thanks a ton man.

I managed to get it to work with the code you provided

Private Sub Worksheet_Change(ByVal Target As Range)
    '   Code goes in the Worksheet specific module
    Dim rng As Range
                Set rng = Target.Parent.Range("A:A")
        '   Only look at single cell changes
            If Target.Count > 1 Then Exit Sub
        '   Only look at that range
            If Intersect(Target, rng) Is Nothing Then Exit Sub
        Selection.Offset(-1, 1).Select
      Selection.Value = Format(Date, "mm.dd.yy")
      Selection.Offset(0, 1).Select
      Selection.Value = Format(Time, "HH:MM:SS")
      Selection.Offset(1, -2).Select
End

End Sub

 

[runchie]

okay so I added some more to it. and it works for the most part.

But I cant figure out how to make it work if the badge # is not found.


this is how it showing up so far
Scan|Last|First|Dept|Emp|Badge|Status|Date|Time
1111| Doe|Joe|Area1|111| 1111| Active|11.11|8:30

I want it to say Unknown in Last name slot. instead of getting and error

Private Sub WorkSheet_Change(ByVal Target As Range)
    '   Code goes in the Worksheet specific module
    
    Dim myRange As Range
    Dim oCell
    
    Dim rng As Range
                Set rng = Target.Parent.Range("A:A")
        '   Only look at single cell changes
            If Target.Count > 1 Then Exit Sub
        '   Only look at that range
            If Intersect(Target, rng) Is Nothing Then Exit Sub


Application.ScreenUpdating = False

Selection.Offset(-1, 0).Select
oCell = Selection.Value


Worksheets("List").Activate

ActiveSheet.Range("E:E").Select
Selection.Find(What:=oCell, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Select
        ActiveCell.Offset(0, 1).Select
        ActiveSheet.Range(ActiveCell, ActiveCell.Offset(0, -5)).Select
        Selection.Copy
        Worksheets("Sign In").Activate
        ActiveCell.Offset(0, 1).Select
        ActiveSheet.Paste
        ActiveCell.Select
        
        
        Selection.Offset(0, 6).Select
        Selection.Value = Format(Date, "mm.dd.yy")
        Selection.Offset(0, 1).Select
        Selection.Value = Format(Time, "HH:MM:SS")
        Selection.Offset(1, -8).Select
        
        Columns("A:H").Select
        Columns("A:H").EntireColumn.AutoFit
        Range("a65536").End(xlUp).Offset(1, 0).Select
        
                 

Application.ScreenUpdating = True

End Sub

 

[runchie]

NVM I got it lol

Added

On Error GoTo Unknown

Unknown:
Worksheets("Sign In").Activate
ActiveCell.Offset(0, 1).Select
Selection.Value = "Unknown"
Selection.Offset(0, 6).Select
        Selection.Value = Format(Date, "mm.dd.yy")
        Selection.Offset(0, 1).Select
        Selection.Value = Format(Time, "HH:MM:SS")
        Selection.Offset(1, -8).Select
Range("a65536").End(xlUp).Offset(1, 0).Select
ActiveCell.EntireRow.ClearContents

Thanks.