VBA code to fill down index-match functions in 7 adjacent cells

Question

I am new to coding and need some assistance. I have created an update button in Excel 2013 that will use the value in column A to fill in values in columns B through H using Index and Match from another spreadsheet. The number of entries in column A will vary and the spreadsheet containing the values for columns B through H has over 6,000 rows and many columns.

I want the code I've written to fill down through the last entry in column A.

Private Sub cmdUpdate_Click()
    With ActiveSheet
         .Range("B2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("B:B"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("C2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("H:H"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("D2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("I:I"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("E2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("G:G"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("F2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("L:L"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("G2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("D:D"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("H2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("E:E"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
    End With
End Sub

Thanks in advance for your help, I appreciate it.

Update: I integrated the code from @Linga as follows. The formulas fill down through the last entry in column A, however it is only copying the data from row 2. It is ignoring the values in column A in successive rows.

Private Sub cmdUpdateWBID_Att_Click()
       Dim a As String
       a = ActiveCell.Row
       With ActiveSheet
         .Range("B2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("B:B"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("C2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("H:H"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("D2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("I:I"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("E2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("G:G"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("F2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("L:L"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("G2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("D:D"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("H2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("E:E"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
       End With
       Range("A2").Select
       Selection.End(xlDown).Select
       Range("B" & a & ":H" & a).Select
       Range(Selection, Selection.End(xlUp)).Select
       Selection.FillDown

End Sub

Update: I wrote a VBA form of the Excel Index and Match formulas in cells B through H. The following formula sits in cell B;

=INDEX(Sheet2!B:B,MATCH(Sheet1!A:A,Sheet2!A:A,0))

A similar formula sits in cells C through H. I wanted to automate this with a button instead of writing 7 formulas and dragging them down. This is an action that I have been repeating a lot with very large datasets.

Sorry, I don't have Snap.

Answer 1

I do this exact thing on an import macro. Here is a one of my lines. This directly applies a formula in column A to a range in a single step. It starts at A2 because there is a header row and uses TableRange.Rows.Count to get the bottom of the table. Get the bottom of yours however works best.

MaxRow = TableRange.Rows.Count
' "DATE"
Range("A2:A" & MaxRow).FormulaR1C1 = "=IF(RC[4]="""","""",DATE(YEAR(RC[4]),MONTH(RC[4]),1))"

To get your formula in "RC" format just record a macro of yourself entering it by hand.

Answer 2

The problem I was having using @Linga's code is that my code placed values in row 2 and his code filled down those values. I needed to place formulas in the row and then @Linga's code would have filled down just like I wanted. A colleague led me in the right direction with my code. The last few lines of code allowed me to remove the formulas from the cells and just leave the values. @Linga's answer did exactly what I asked.

Private Sub cmdUpdateWBID_Att_Click()
Dim a As Integer
Range("B2").Select
ActiveCell.FormulaR1C1 = _
    "=INDEX(Sheet2!C,MATCH(Sheet1!RC[-1],Sheet2!C[-1],0))"
Range("C2").Select
ActiveCell.FormulaR1C1 = _
    "=INDEX(Sheet2!C[5],MATCH(Sheet1!RC[-2],Sheet2!C[-2],0))"
Range("D2").Select
ActiveCell.FormulaR1C1 = _
    "=INDEX(Sheet2!C[5],MATCH(Sheet1!RC[-3],Sheet2!C[-3],0))"
Range("E2").Select
ActiveCell.FormulaR1C1 = _
    "=INDEX(Sheet2!C[2],MATCH(Sheet1!RC[-4],Sheet2!C[-4],0))"
Range("F2").Select
ActiveCell.FormulaR1C1 = _
    "=INDEX(Sheet2!C[6],MATCH(Sheet1!RC[-5],Sheet2!C[-5],0))"
Range("G2").Select
ActiveCell.FormulaR1C1 = _
    "=INDEX(Sheet2!C[-3],MATCH(Sheet2!RC[-6],Sheet2!C[-6],0))"
Range("H2").Select
ActiveCell.FormulaR1C1 = _
    "=INDEX(Sheet2!C[-3],MATCH(Sheet1!RC[-7],Sheet2!C[-7],0))"
Range("A2").Select
Selection.End(xlDown).Select
a = ActiveCell.Row
Range("B" & a & ":H" & a).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

End Sub

Answer 3

Use this macro after applying the formulas from B to H, hope this is what you expected.

Private Sub cmdUpdateWBID_Att_Click()
       Dim a As Integer
       
       With ActiveSheet
         .Range("B2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("B:B"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("C2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("H:H"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("D2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("I:I"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("E2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("G:G"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("F2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("L:L"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("G2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("D:D"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
         .Range("H2") = Application.WorksheetFunction.Index(Sheets("Sheet2").Range("E:E"), Application.WorksheetFunction.Match(Sheets("Sheet1").Range("A2"), (Sheets("Sheet2").Range("A:A")), 0))
      End With  

       Range("A2").Select
       Selection.End(xlDown).Select
       a = ActiveCell.Row
       Range("B" & a & ":H" & a).Select
       Range(Selection, Selection.End(xlUp)).Select
       Selection.FillDown
   
End Sub