Auto populate table from another worksheet

[markkeith]

I'm trying to populate a table with data from another worksheet based on result on Vlookup.

Sheet1 Range("receiptNum") has a number data that will be searched from Sheet4("transcTable") and when I run the Sub it actually found the "matched number" however it continue to write data all the way down to destination table. Also what code do I need to add to handle error if No data found?

Here's my code:


Sub recordSearch()
Dim ws As Worksheet
Dim intItems As Integer
Dim cellx As Range, rowX As Range
Set rowX = Sheet1.Range("A12")


Application.EnableEvents = False
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
ws.Unprotect
Next ws


Range("date").Value = Application.VLookup(Range("receiptNum"), Range("transcTable"), 2, False) 'Date
Range("name").Value = Application.VLookup(Range("receiptNum"), Range("transcTable"), 3, False) 'Name


intItems = 0
For Each cellx In Range("receiptNumRec")
CellXRow = CellXRow + 1
If Range("receiptNum").Value > "" Then
intItems = intItems + 1
rowX.Offset(intItems - 1, 1).Value = Application.VLookup(Range("receiptNum"), Range("transcTable"), 1, False)
If rowX.Offset(intItems - 1, 1).Value > "" Then
rowX.Offset(intItems - 1).Value = intItems 'Item Num
End If


End If
Next cellx


For Each ws In ActiveWorkbook.Worksheets
ws.Protect , DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
Next ws
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

[snb]

Post a sample workbook, please.
Avoid the use of Excel functions in VBA.

[markkeith]

Hi snb, thanks for your reply. I tried to attached the workbook but it exceeded the 1MB limit, will try to resize then post here later.

27077

[markkeith]

I don't know why I can't reduce the file size of my actual workbook (although I removed & deleted so much codes, data & formatting) and I need to make a similar one so I can attached a sample workbook here.

I did some changes to the codes but still I'm not getting the expected result.
This is how I want the codes to do, when I click the button I need the data from ReceiptNum to be searched from transcTable using Vlookup and write the results to Sheet1.


Sub recordSearch()
Dim ws As Worksheet
Dim intItems As Integer
'Dim CellXRow As Long
Dim product As Range, cellx As Range
Set product = Sheet1.Range("C6:C34")


Application.EnableEvents = False
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
ws.Unprotect
Next ws


Range("date").Value = Application.VLookup(Range("receiptNum"), Range("transcTable"), 2, False) 'Date
Range("name").Value = Application.VLookup(Range("receiptNum"), Range("transcTable"), 3, False) 'Name


intItems = 0
For Each cellx In product
If Range("receiptNum").Value > "" Then
intItems = intItems + 1
cellx.Offset(, -2).Value = intItems 'Item Num
cellx.Offset(, -1).Value = Application.VLookup(Range("receiptNum"), Range("transcTable"), 4, False) 'Type
cellx.Value = Application.VLookup(Range("receiptNum"), Range("transcTable"), 5, False) 'Description
cellx.Offset(, 1).Value = Application.VLookup(Range("receiptNum"), Range("transcTable"), 6, False) 'Qty
cellx.Offset(, 2).Value = Application.VLookup(Range("receiptNum"), Range("transcTable"), 7, False) 'Unit


End If
Next cellx


For Each ws In ActiveWorkbook.Worksheets
ws.Protect , DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
Next ws
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


27078

Any help would be appreciated.

[snb]

Never, never, post protected workbooks in a public forum.
Never use merged cells.
Always use column A and row 1 in a worksheet. (unlike your sheet2)
Always use Excel's built-in options:


Private Sub CommandButton1_Click()
If Cells(2, 6) <> "" Then
Sheet2.Cells(2, 26) = Cells(2, 6)
Sheet2.ListObjects(1).Range.AdvancedFilter 2, Sheet2.Range("Z1:Z2"), Sheet1.Cells(5, 1)
End If
End Sub

[markkeith]

I guess I need to read first the Forum Rules before posting question here. Thank you for your replies.

[markkeith]

I like this simple code however I can't make it work in my Sample Wbook, is it like filter then copyPaste? if so the source & destination table is not equal in column count. Please be patient with me, I'm really a beginner here.





Private Sub CommandButton1_Click()
If Cells(2, 6) <> "" Then
Sheet2.Cells(2, 26) = Cells(2, 6)
Sheet2.ListObjects(1).Range.AdvancedFilter 2, Sheet2.Range("Z1:Z2"), Sheet1.Cells(5, 1)
End If
End Sub

[snb]

Didn't you test it ?

[markkeith]

Yes I did, actually several times and every time I got an error. Can you please post my Sample WBook with your code on it.
By the way what do you mean when you say " Avoid the use of Excel functions in VBA" and "Always use Excel's built-in options"?

[snb]

Private Sub CommandButton1_Click()
with Sheet2
If .Cells(2, 6) <> "" Then
Sheet1.Cells(5, 1).currentregion.clearcontents
.cells(1,26) = .cells(1).value
.Cells(2, 26) = .Cells(2, 6)
.ListObjects(1).Range.AdvancedFilter 2, .Range("Z1:Z2"), Sheet1.Cells(5, 1)
End If
end wirh
End Sub

[markkeith]

Thank you, after a few edits on your code it actually works on my sample wbook. It filter & copyPaste data from sheet1 to sheet2 though both tables are NOT same in column number. I will play around & explore possibilities if I can copy certain columns only.