Populate table from another worksheet using vlookup in a loop

[markkeith]

First of all I'm new to VBA and was trying to learn the advantage of using it in Excel.
I have Sheet1 (POS) with blank table that I want to be populated with data from Sheet2 (Records) transcTable when I clicked a button. Source & destination table is NOT same in format & number of columns.
I was trying to loop vlookup (not sure if it's the right way to do) to find Receipt No. from Sheet2 then return all other column data to Sheet1.



Here's the code I made so far.

Private Sub CommandButton1_Click()
Dim i As Integer
Dim lng As Long
Dim cellx As Range, rowX As Range, numX
Set rowX = Sheet1.Cells(Rows.Count, "A").End(xlUp).Offset(1)

 numX = Application.VLookup(Range("receiptNum"), Sheet2.Range("transcTable"), 1, False)
 If Not IsError(numX) Then
   Range("date").Value = Application.VLookup(Range("receiptNum"), Sheet2.Range("transcTable"), 2, False) 'Date
   Range("name").Value = Application.VLookup(Range("receiptNum"), Sheet2.Range("transcTable"), 3, False) 'Name

   i = 0
   lng = 0
   For Each cellx In Sheet1.Range("C6:C34")
    i = i + 1
    lng = lng + 1
     rowX.Offset(lng - 1).Value = i 'Item Num
     rowX.Offset(lng - 1, 1).Value = Application.VLookup(Range("receiptNum"), Sheet2.Range("transcTable"), 4, False) 'Type
     rowX.Offset(lng - 1, 2).Value = Application.VLookup(Range("receiptNum"), Sheet2.Range("transcTable"), 5, False) 'Description
     rowX.Offset(lng - 1, 3).Value = Application.VLookup(Range("receiptNum"), Sheet2.Range("transcTable"), 6, False) 'Qty
     rowX.Offset(lng - 1, 4).Value = Application.VLookup(Range("receiptNum"), Sheet2.Range("transcTable"), 7, False) 'Unit
   Next cellx
 Else
   MsgBox "Receipt Number doesn't exist!"
 End If

End Sub

 

[LazyBug]

Could you show your final result (made by hand) or insert image of it with one Recept #?
You can use Xl2BB tool.

 

[markkeith]

Excel is always not responding whenever I try to use the add-ins, see below image of the result of CommandButton1_Click(). There should be multiple rows of different data but it only show same one all the way down.

Could you show your final result (made by hand) or insert image of it with one Recept #?
You can use Xl2BBtool.

 

[LazyBug]

I'm afraid I can't help you with your requests as I don't able to create macro instead of Vlookup function with two columns for search and with all results output. But maybe other forum members will help.

 

[markkeith]

I'm afraid I can't help you with your requests as I don't able to create macro instead of Vlookup function with two columns for search and with all results output. But maybe other forum members will help.

Vlookup lookup_value is just one cell, Sheet1.cells(2, 6) or named range "receiptNum. I think the problem is, its the same lookup_value inside loop that's why same result all the time.

 

[markkeith]

My workaround is to use ListObjects.Range.AdvancedFilter then loop vlookup on extracted table, I know it's a complicated code but at least it works. AdvancedFilter is a great function only if source and destination table is identical in format & number of columns.

Private Sub btnSearch_Click()
Dim ws As Worksheet, numX
numX = Application.VLookup(Range("receiptNum"), Sheet4.Range("transcTable"), 1, False)

If Not IsError(numX) Then
Application.EnableEvents = False
Application.ScreenUpdating = False
 For Each ws In ActiveWorkbook.Worksheets
  ws.Unprotect
 Next ws
 
  With Sheet4
    If Sheet1.Cells(8, 6) <> "" Then
      .Cells(1, 10).CurrentRegion.ClearContents
      .Cells(1, 19) = .Cells(1).Value
      .Cells(2, 19) = Sheet1.Cells(8, 6)
      .ListObjects(1).Range.AdvancedFilter 2, .Range("S1:S2"), .Cells(1, 10)
    End If
  End With
 Range("pickSlipClear,contactDetails").ClearContents
 Call transcSearch 'run Search function
 Cells(Rows.Count, "C").End(xlUp).Offset(2).Select
    
 For Each ws In ActiveWorkbook.Worksheets
  ws.Protect , DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
 Next ws
 Application.ScreenUpdating = True
 Application.EnableEvents = True
 
Else
 MsgBox "Receipt Number doesn't exist!"
 Cells(Rows.Count, "C").End(xlUp).Offset(2).Select
 
End If
End Sub

Sub transcSearch()
Dim i As Integer
Dim lng As Long
Dim xcell As Range, rowX As Range
Set rowX = Sheet1.Cells(12, 1)

 Range("date").Value = Application.VLookup(Range("receiptNum"), Sheet4.Range("transcTable"), 2, False) 'Date
 Range("name").Value = Application.VLookup(Range("receiptNum"), Sheet4.Range("transcTable"), 3, False) 'Name
   i = 0
   lng = 0
   For Each xcell In Range("prodX")
    i = i + 1
    lng = lng + 1
    If xcell.Value > "" Then
      rowX.Offset(lng - 1).Value = i 'Item Num
      rowX.Offset(lng - 1, 1).Value = Application.VLookup(xcell.Value, Sheet4.Range("filterX"), 2, False) 'Type
      rowX.Offset(lng - 1, 2).Value = Application.VLookup(xcell.Value, Sheet4.Range("filterX"), 1, False) 'Description
      rowX.Offset(lng - 1, 3).Value = Application.VLookup(xcell.Value, Sheet4.Range("filterX"), 3, False) 'Qty
      rowX.Offset(lng - 1, 4).Value = Application.VLookup(xcell.Value, Sheet4.Range("filterX"), 4, False) 'Unit
      rowX.Offset(lng - 1, 7).formula = "=IFERROR(INDEX(dataTable[ON-HAND],MATCH(@desc,dataTable[Product Description],0)),0)" ' Available stock
      rowX.Offset(lng - 1, 8).formula = "=IFERROR(INDEX(dataTable[Supplier],MATCH(@desc,dataTable[Product Description],0)),0)" 'Stock cost price
    End If
   Next xcell
End Sub