This is my first time posting so not sure if Iam doing this right.
I want ascan out/in system for scanning items out and back in again with a time stamp,below is what I have a the moment
LabelCode Time Out Time In
0615W 05/02/2019 11:00 05/02/201911:52
PrivateSub Worksheet_Change(ByVal Target As Range)
IfIntersect(Target, Range("A4:A3000")) Is Nothing Then Exit Sub
IfTarget.Count > 1 Then Exit Sub
IfTarget = "" Then Exit Sub
Dim lc AsLong, fr As Long, n As Long, nr As Long
WithApplication
.EnableEvents = False
.ScreenUpdating = False
n= Application.CountIf(Columns(1), Cells(Target.Row, 1))
If n = 1 Then
lc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column
If lc = 1 Then
Cells(Target.Row, lc + 2) = Format(Now, "m/d/yyyy h:mm")
ElseIf lc > 2 Then
Cells(Target.Row, lc + 1) = Format(Now, "m/d/yyyy h:mm")
End If
Else
fr = 0
On Error Resume Next
fr = Application.Match(Cells(Target.Row, 1), Columns(1), 0)
On Error GoTo 0
If fr > 0 Then
lc = Cells(fr, Columns.Count).End(xlToLeft).Column
If lc = 1 Then
Cells(fr, lc + 2) = Format(Now, "m/d/yyyy h:mm")
ElseIf lc > 2 Then
Cells(fr, lc + 1) = Format(Now, "m/d/yyyy h:mm")
End If
Target.ClearContents
End If
End If
On Error Resume Next
Me.Range("A4", Range("A" &Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
nr = Me.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
Me.Cells(nr, 1).Select
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
I wouldalso like when I have scanned the label code out and the time is applied Iwould also like to scan another barcode which will have a line number in it,also when the item is scanned back in I would like it to start a new row ratherthan carrying on the same row if the same label code is scanned again asanother item with the same label code may go out to another line see examplebelow. I am very new to all this so any help would be great.
Label Code Time Out Time In Line Number
0615W 05/02/2019 11:00 6
Label Code Time Out Time In Line Number
0615W 05/02/2019 11:03 4
I want ascan out/in system for scanning items out and back in again with a time stamp,below is what I have a the moment
LabelCode Time Out Time In
0615W 05/02/2019 11:00 05/02/201911:52
PrivateSub Worksheet_Change(ByVal Target As Range)
IfIntersect(Target, Range("A4:A3000")) Is Nothing Then Exit Sub
IfTarget.Count > 1 Then Exit Sub
IfTarget = "" Then Exit Sub
Dim lc AsLong, fr As Long, n As Long, nr As Long
WithApplication
.EnableEvents = False
.ScreenUpdating = False
n= Application.CountIf(Columns(1), Cells(Target.Row, 1))
If n = 1 Then
lc = Cells(Target.Row, Columns.Count).End(xlToLeft).Column
If lc = 1 Then
Cells(Target.Row, lc + 2) = Format(Now, "m/d/yyyy h:mm")
ElseIf lc > 2 Then
Cells(Target.Row, lc + 1) = Format(Now, "m/d/yyyy h:mm")
End If
Else
fr = 0
On Error Resume Next
fr = Application.Match(Cells(Target.Row, 1), Columns(1), 0)
On Error GoTo 0
If fr > 0 Then
lc = Cells(fr, Columns.Count).End(xlToLeft).Column
If lc = 1 Then
Cells(fr, lc + 2) = Format(Now, "m/d/yyyy h:mm")
ElseIf lc > 2 Then
Cells(fr, lc + 1) = Format(Now, "m/d/yyyy h:mm")
End If
Target.ClearContents
End If
End If
On Error Resume Next
Me.Range("A4", Range("A" &Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
nr = Me.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
Me.Cells(nr, 1).Select
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
I wouldalso like when I have scanned the label code out and the time is applied Iwould also like to scan another barcode which will have a line number in it,also when the item is scanned back in I would like it to start a new row ratherthan carrying on the same row if the same label code is scanned again asanother item with the same label code may go out to another line see examplebelow. I am very new to all this so any help would be great.
Label Code Time Out Time In Line Number
0615W 05/02/2019 11:00 6
Label Code Time Out Time In Line Number
0615W 05/02/2019 11:03 4
