Scan out/in System (VBA HELP NEEDED)

johnsonk

Board Regular
Joined
Feb 4, 2019
Messages
172
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
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

Forum statistics

Threads
1,224,822
Messages
6,181,165
Members
453,021
Latest member
Justyna P

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