Forum Discussion
Insert formula to a cell using VBA and autofill formula to the cells below
Try this:
Sub Test() Dim therow As Long Dim lastrow As Long Application.ScreenUpdating = False With ThisWorkbook.Worksheets("Dest") lastrow = .Cells(.Rows.Count, 2).End(xlUp).Row For therow = 5 To lastrow .Cells(therow, 10).Value = Evaluate( _ "=INDEX(Source!$J:$J, MATCH(1,(Source!$C:$C=$C" & _ therow & ")*(Source!$D:$D=$D" & therow & "),0))") Next therow End With Application.ScreenUpdating = True End Sub
Thanks. Try this:
Private Sub CommandButton1_Click()
Dim targetwb As Workbook
Dim thisws As Worksheet
Dim targetFN As String
Dim wsTbl As ListObject, lookupTbl As ListObject
Dim rw As Long
Dim rng1 As Range, rng2 As Range, rng3 As Range
Dim adr1 As String, adr2 As String, adr3 As String
Set thisws = ThisWorkbook.Worksheets("Execute")
targetFN = thisws.Range("C4").Value & "\" & thisws.Range("C3").Value & ".xlsx"
Set targetwb = Workbooks.Open(targetFN)
Set wsTbl = targetwb.Worksheets("Sheet1").ListObjects("Table1")
Set lookupTbl = targetwb.Worksheets("PO_Line_Details").ListObjects("AtlasReport_1_Table_1")
Set rng1 = lookupTbl.ListColumns("Line No").DataBodyRange
adr1 = rng1.Address(External:=True)
Set rng2 = lookupTbl.ListColumns("Purchase order").DataBodyRange
adr2 = rng2.Address(External:=True)
Set rng3 = lookupTbl.ListColumns("Item number").DataBodyRange
adr3 = rng3.Address(External:=True)
For rw = wsTbl.DataBodyRange.Rows.Count To 1 Step -1
If wsTbl.DataBodyRange(rw, 1).Value <> "" Then
wsTbl.DataBodyRange(rw, 2).Value = _
Evaluate("INDEX(" & adr1 & ", " & _
"MATCH(1,(" & adr2 & "=""" & _
wsTbl.DataBodyRange(rw, 1).Value & _
""")*(" & adr3 & "=""" & _
wsTbl.DataBodyRange(rw, 3).Value & """),0))")
End If
Next rw
End Sub
It works. Thank you so much for your help on providing the solution.
I learned from you how to code for structured table in vba. Greatly appreciated.
Have a good weekend ahead!
Sorry to bother you again. I have added the "Quantity" field to the index match formula but I got #N/A error which I suspect that my double quotes in the Evaluate statement for the index match are incorrect but I do not know how to fix. My updated VBA codes are as follows:
Private Sub CommandButton1_Click()
Dim targetwb As Workbook
Dim thisws As Worksheet
Dim targetFN As String
Dim lookupTbl As ListObject
Dim rw As Long, lastrow As Long
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
Dim adr1 As String, adr2 As String, adr3 As String, adr4 As String
Set thisws = ThisWorkbook.Worksheets("Output")
targetFN = thisws.Range("L3").Value & "\" & thisws.Range("L2").Value & ".xlsx"
Set targetwb = Workbooks.Open(targetFN)
Set lookupTbl = targetwb.Worksheets("PO_Line_details").ListObjects("AtlasReport_1_Table_1")
Set rng1 = lookupTbl.ListColumns("Line No").DataBodyRange
adr1 = rng1.Address(External:=True)
Set rng2 = lookupTbl.ListColumns("Purchase order").DataBodyRange
adr2 = rng2.Address(External:=True)
Set rng3 = lookupTbl.ListColumns("Item number").DataBodyRange
adr3 = rng3.Address(External:=True)
Set rng4 = lookupTbl.ListColumns("Quantity").DataBodyRange
adr4 = rng4.Address(External:=True)
lastrow = thisws.Cells(Rows.Count, 1).End(xlUp).Row
For rw = 6 To lastrow
If thisws.Cells(rw, 1).Value <> "" Then
thisws.Cells(rw, 2).Value = _
Evaluate("INDEX(" & adr1 & ", " & _
"MATCH(1,(" & adr2 & "=""" & _
thisws.Cells(rw, 1).Value & _
""")*(" & adr3 & "=""" & _
thisws.Cells(rw, 3).Value & _
""")*(" & adr4 & "=""" & _
thisws.Cells(rw, 4).Value & """),0))")
End If
Next rw
End Sub
I have attached both the read table and output file with the VBA codes.
Thank you in advance for your advice and help.