Search code examples
vbaexcelbarcode-scanner

Fix VB Excel Macro, search and copy/paste loop, 2 sheets

I am a novice coder. I have found a few examples and tutorials to get my code to where it is, but it returns an

error "400"

which I have found to not be all that easy to diagnose. My goal is simple. I have a 2 sheet workbook. Sheet 1 is an order form ("PO"), and sheet 2 is a database ("DataBase"). I have this subroutine in the workbook (not one of the sheets). It prompts the user to scan a barcode, and then searches sheet "DataBase" for that part number, and then copy/pastes the next 3 cells to the right back into the original sheet "PO".

There is a little more built in, like the ability to terminate the loop if a specific barcode is scanned (xxxDONExxxx). I also am trying to find a way to to return an error message (ErrMsg2) if no match is found.

If I step through the subroutine using F8, it gets past the scanner input, and then fails the line with the note ('FAIL'). I would appreciate some help to get this working.

Option Explicit

Sub inventory()

'**** Define variables ****'
Dim partnumber As String
Dim lastrow As Integer
Dim i As Integer
Dim x As Integer
'Dim xxxDONExxxx As String

'**** Clear paste area in sheet "PO" ****'
Sheets("PO").Range("A17:F31").ClearContents

'**** Set row count ****'
lastrow = 100 'Sheets("DataBase").Range("B500").End(x1Up).Row

'**** select first cell to paste in****'
Range("A17").Select

'**** loop for scanning up to 30 lines ****'
For i = 1 To 30

    '**** Prompt for input ****'
    partnumber = InputBox("SCAN PART NUMBER")

    '**** Abort if DONE code is scanned ****'
    If ("partnumber") = ("xxxDONExxxx") Then GoTo ErrMsg1

        '**** search DataBase for match in B, copy CDE /paste in PO BDE****'
        For x = 2 To lastrow

        If ("partnumber") = Sheets("DataBase").Range("x, 2") Then '*FAIL*'
        ActiveCell.Offset(0, 1) = Sheets("DataBase").Cells(x, 1)
        ActiveCell.Offset(0, 2) = Sheets("DataBase").Cells(x, 2)
        ActiveCell.Offset(0, 3) = Sheets("DataBase").Cells(x, 3)

        End If

        Next x

Next i

ErrMsg1:
MsgBox ("Operation Done - user input")
ErrMsg2:
MsgBox ("Part Number does not Exist, add to DataBase!")
End Sub

Sheet 1 - "PO"

enter image description here

Sheet 2 - "Database"

enter image description here

Solution

  • I know there are more efficient ways to do this, but this will do what you expect: 

    Option Explicit

Sub inventory()
'**** Define variables ****'
Dim wsData As Worksheet: Set wsData = Sheets("DataBase")
Dim wsPO As Worksheet: Set wsPO = Sheets("PO")
Dim partnumber As String
Dim lastrow As Long
Dim i As Long
Dim x As Long
Dim Found As String
Found = False
'**** Clear paste area in sheet "PO" ****'
wsPO.Range("A17:F31").ClearContents

'**** Set row count on Database Sheet ****'
lastrow = wsData.Cells(wsData.Rows.Count, "B").End(xlUp).Row

'select the last row with data in the given range
wsPO.Range("A17").Select

ScanNext:
'**** Prompt for input ****'
partnumber = InputBox("SCAN PART NUMBER")

'**** Abort if DONE code is scanned ****'
If partnumber = "xxxDONExxxx" Then
    MsgBox ("Operation Done - user input")
    Exit Sub
Else
    Selection.Value = partnumber
End If

'**** search DataBase for match in B, copy CDE /paste in PO BDE****'
 For x = 2 To lastrow
     If wsPO.Cells(Selection.Row, 1) = wsData.Cells(x, 2) Then
         wsPO.Cells(Selection.Row, 2) = wsData.Cells(x, 3)
         wsPO.Cells(Selection.Row, 5) = wsData.Cells(x, 4)
         wsPO.Cells(Selection.Row, 6) = wsData.Cells(x, 5)
         Found = "True"
     End If
 Next x

 If Found = "False" Then
     MsgBox "Product Not Found in Database!", vbInformation
     Selection.Offset(-1, 0).Select
 Else
     Found = "False"
 End If


If Selection.Row < 31 Then
    Selection.Offset(1, 0).Select
    GoTo ScanNext
Else
    MsgBox "This inventory page is now full!", vbInformation
End If
End Sub