VBA code to search from different sheet > Copy the row > Paste on different sheet.

Hi All,

I am seeking your help on VBA code.

1. Currently i had a range of data in sheet1 ( A1:G4000 )
2. Sheet1 Col A1 are Unique alphanumeric code. ( Use to generate Barcode )
3. Under sheet2 A1:A4000 will be input, which user will scan the barcode.
4. Once the barcode scanned and input to range of A1:A4000, the cell will be uneditable with password protection.
5. If the same barcode being scanned again, it will not capture in range A1:A4000. Active cell will remain at the empty cell to be ready for input again.

Above is the function that will be in Range A1:A4000. Below is the trigger needed whenever the barcode scanned / the cell had input.

6. Whenever the Cell Range of A1:A4000 had a input, VBA will trigger and search over the Sheet1 A1:A4000. Once the Unique code searched, copy Bx:Gx and paste into the cell which under the same room of the Barcode being scanned. And finally the entire row will be protected ( If this option is not available, is ok ).


Appreciate that someone can enlighten me on this option with VBA. As i do not have any knowledge on VBA coding. Thanks

Hi qpywsqp,
try this (see attachment)
password for Sheet2 is "111" (without quotes)

Hi Nilem, thanks a lot to answer my question.

The code is looking good, just that a few more step to final tune. Not sure below listed possible to happen or not, please advice.

1. If sheet2 A2:A10 has data, possible to add in a code to prevent skip row? Meaning that if i key in a data in A15, it will automatically key into A11 instead?
2. I found the code you provided are not allow to delete the data on Col Bx:Gx when Ax has a valid data. Possible to make it only Col A is allow to key in data?

Besides that if i would like to make the range wider, am i just need to adjust the figure under? :
" If Not r Is Nothing Then
With Target.Resize(, 20)
.Value = r.Resize(, 20).Value: .Locked = True"

yes, Target.Resize(, 20).Value = r.Resize(, 20).Value
try again

Thank Nilem.

It looks good after revised. At the moment i did not have barcode scanner with me to really test out the file.

Once i tried, if there is any amend need to fine tune ill reply from here. Hope you can solve my problem.

Many many thanks for you help. Thank you.

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