Stewart11715
New Member
- Joined
- Nov 12, 2013
- Messages
- 5
Hello. I would like to change the vba code when I scan an id it will post the student's id one column and the date if possible into the next column.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' hiker95, 05/27/2013
' Scan barcode to excel with date & time stamp in & out.
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Dim lr As Long, lc As Long, nc As Long, fr As Long, n As Long, nr As Long
With Application
.EnableEvents = False
.ScreenUpdating = False
n = Application.CountIf(Columns(4), Range("A1"))
If n = 0 Then
nr = Range("D" & Rows.Count).End(xlUp).Offset(1).Row
Range("D" & nr) = Range("A1")
Range("A1").ClearContents
Cells(nr, 8) = Format(Now, "mmm dd,yyyy h:mm AM/PM")
Columns(8).AutoFit
Cells(nr, 1).Resize(, 3) = "???"
Cells(nr, 5).Resize(, 3) = "???"
ElseIf n > 0 Then
fr = 0
On Error Resume Next
fr = Application.Match(Range("A1"), Columns(4), 0)
On Error GoTo 0
lc = Cells(fr, Columns.Count).End(xlToLeft).Column
If lc < 8 Then
Cells(fr, 8) = Format(Now, "mmm dd,yyyy h:mm AM/PM")
Columns(8).AutoFit
ElseIf lc > 7 Then
Cells(fr, lc + 1) = Format(Now, "mmm dd,yyyy h:mm AM/PM")
Columns(lc + 1).AutoFit
End If
End If
With Range("A1")
.ClearContents
.Select
End With
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' hiker95, 05/27/2013
' Scan barcode to excel with date & time stamp in & out.
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Dim lr As Long, lc As Long, nc As Long, fr As Long, n As Long, nr As Long
With Application
.EnableEvents = False
.ScreenUpdating = False
n = Application.CountIf(Columns(4), Range("A1"))
If n = 0 Then
nr = Range("D" & Rows.Count).End(xlUp).Offset(1).Row
Range("D" & nr) = Range("A1")
Range("A1").ClearContents
Cells(nr, 8) = Format(Now, "mmm dd,yyyy h:mm AM/PM")
Columns(8).AutoFit
Cells(nr, 1).Resize(, 3) = "???"
Cells(nr, 5).Resize(, 3) = "???"
ElseIf n > 0 Then
fr = 0
On Error Resume Next
fr = Application.Match(Range("A1"), Columns(4), 0)
On Error GoTo 0
lc = Cells(fr, Columns.Count).End(xlToLeft).Column
If lc < 8 Then
Cells(fr, 8) = Format(Now, "mmm dd,yyyy h:mm AM/PM")
Columns(8).AutoFit
ElseIf lc > 7 Then
Cells(fr, lc + 1) = Format(Now, "mmm dd,yyyy h:mm AM/PM")
Columns(lc + 1).AutoFit
End If
End If
With Range("A1")
.ClearContents
.Select
End With
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub