Huge data index/match replacement

Sorry, i'm making use of the data in an past post,how can i change the 2-dimension index/match to vba?
i know how to do it with formula (as attached logic) but don't know how i can shorten the process time.... i have >40,000 rows in the file and need to pops up results for >20 columns..
Attachment 529906

I am moving this to the VBA section.

Will you please attach a sample Excel workbook? We are not able to work with or manipulate a picture of one.

1. Make sure that your sample data are REPRESENTATIVE of your real data. The use of unrepresentative data is very frustrating and can lead to long delays in reaching a solution.

2. Make sure that your desired solution is also shown (mock up the results manually).

3. Make sure that all confidential data is removed or replaced with dummy data first (e.g. names, addresses, E-mails, etc.).

4. Try to avoid using merged cells as they cause lots of problems.

Unfortunately the attachment icon doesn't work at the moment, so to attach an Excel file you have to do the following: just before posting, scroll down to Go Advanced and then scroll down to Manage Attachments. Now follow the instructions at the top of that screen.

Please pay particular attention to point 2 (above): without an idea of your intended outcomes, it is often very difficult to offer appropriate advice.

Maybe :

Sub Test()
  Dim a, b, c As New Collection, i As Long, j As Long, p As Long
  With Sheets("VBA FOR INDEX MATCH IN COL D")
    a = .Range("I1:M" & .Cells(.Rows.Count, "I").End(xlUp).Row).Value
    b = .Range("C1:G" & .Cells(.Rows.Count, "C").End(xlUp).Row).Value
    For i = 2 To UBound(a, 2)
        For j = 2 To UBound(b, 2)
            If a(1, i) = b(1, j) Then a(1, i) = j: Exit For
        Next j
        If Val(a(1, i)) = 0 Then a(1, i) = Empty
    Next i
    For i = 2 To UBound(a, 1)
        On Error Resume Next
           c.Add key:=a(i, 1), Item:=i
        On Error GoTo 0
    Next i
    For i = 2 To UBound(b, 1)
        p = 0
        On Error Resume Next
           p = c(b(i, 1))
        On Error GoTo 0
        If p > 0 Then
           For j = 2 To UBound(b, 2)
               If Not IsEmpty(a(1, j)) Then b(i, j) = a(p, a(1, j))
           Next j
        End If
    Next i
    .Range("C1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  End With
End Sub

You are welcome.
Of course the macro on post #3 won't work for your newest file on post #4, they have different layout.
This is the macro for your newest file on post #4 :

Sub Test()
  Dim rng As Range, arrDec, arrCon, arrTop, arrLeft, i As Long, j As Long, p1 As Long, p2 As Long, startTime As Single, endTime As Single

  'Log start timer
  startTime = Timer

  'Get arrays
  arrDec = Sheets("decimal").Range("A1").CurrentRegion.Value
  With Sheets("Cty Contracts").Range("A1").CurrentRegion
    Set rng = .Range("E2:" & Split(.Address, ":")(1))
    arrCon = Sheets("Contract").Range(rng.Address).Value
    arrTop = rng.Offset(-1).Resize(1).Value
    arrLeft = rng.Offset(, -rng.Column + 1).Resize(, 1).Value
  End With

  'Change items to be matched to uppercase
  For i = 1 To UBound(arrDec, 1): arrDec(i, 1) = UCase$(arrDec(i, 1)): Next i
  For i = 1 To UBound(arrDec, 2): arrDec(1, i) = UCase$(arrDec(1, i)): Next i
  For i = 1 To UBound(arrTop, 2): arrTop(1, i) = UCase$(arrTop(1, i)): Next i
  For i = 1 To UBound(arrLeft, 1): arrLeft(i, 1) = UCase$(arrLeft(i, 1)): Next i

  'Get index
  For i = 1 To UBound(arrTop, 2)
      For j = 1 To UBound(arrDec, 2)
          If arrTop(1, i) = arrDec(1, j) Or Left$(arrTop(1, i), 12) = arrDec(1, j) Then arrTop(1, i) = j: Exit For
      Next j
      If Not IsNumeric(arrTop(1, i)) Then arrTop(1, i) = 0
  Next i
  For i = 1 To UBound(arrLeft, 1)
      For j = 1 To UBound(arrDec, 1)
          If arrLeft(i, 1) = arrDec(j, 1) Then arrLeft(i, 1) = j: Exit For
      Next j
      If Not IsNumeric(arrLeft(i, 1)) Then arrLeft(i, 1) = 0
  Next i

  'Calc
  For i = 1 To UBound(arrCon, 1)
      p1 = arrLeft(i, 1)
      If p1 > 0 Then
         For j = 1 To UBound(arrCon, 2)
             p2 = arrTop(1, j)
             If p2 > 0 Then
                arrCon(i, j) = arrCon(i, j) / arrDec(p1, p2)
             End If
         Next j
      End If
  Next i

  'Write output
  Application.ScreenUpdating = False
    rng.Resize(UBound(arrCon, 1), UBound(arrCon, 2)).Value = arrCon
  Application.ScreenUpdating = True
  
  'Log end timer
  endTime = Timer
  Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
End Sub

How do you get the error ?
Is it :

1. You download my attachment on post #5 and run the macro, and you got the error

or

2. You apply the macro on post #5 to your actual workbook, and you got the error

If it is the number 2, then you must upload your actual workbook, so I can look for the cause (probably caused by a different data layout).