Insert formula to a cell using VBA and autofill formula to the cells below

@Hans Vogelaar

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.

HansVogelaar 

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!

Doris1785 

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

HansVogelaar 

Do I have to specify the workbook or worksheet name for table "AtlasReport_1_Table_1"?

I got #VALUE! error when I run the code from another workbook named "Code file". I have attached the workbook with the VBA codes. The error seems to suggest that it can't find the lookup value.

Doris1785 

As far as I can tell, you only need to change the line

    Set wsTbl = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1")

to

    Set wsTbl = Workbooks("...").Worksheets("Sheet1").ListObjects("Table1")

where ... is the name of the workbook containing the data. It should be open in Excel - if necessary, you can open it at the beginning of the macro.