Hi Nilem,

Finally i got my scanner with me to try out your code. It is working nearly perfect to what i am looking at. Perhaps you can help me to look into below macro coding.
This is one of my existing workbook coding, which i used to keep track the timestamp and datestamp. Current macro code whenever you scan a barcode it will date & time stamp on column B, if duplicate barcode scan it will stamp current date & time on the next column at same row. The active cell always at column A, if active cell skip for more than one row whenever new barcode scan it will key in back to the next cell after the last data being capture.

I hope you can help me to modify the existing code into copy related data which belongs to the code under sheet1. Just like what you have gave me the last document. Hope that you can understand my english. Thanks in advanced.



Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:A3000")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Dim lc As Long, fr As Long, n As Long, nr As Long
With Application
.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
Cells(fr, lc + 1) = Format(Now, "m/d/yyyy h:mm")
Target.ClearContents
End If
End If
On Error Resume Next
Me.Range("A1", 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