Speed up macro of index match formulas running

A

Apple08

Active Member
Joined
Nov 1, 2014
Messages
450
Hi All

I have a set of macro below to insert the index match formulas. However this takes a few hours to finish the macro. Please can anyone help to speed up the macro running time? Many thanks.

VBA Code: 
Private Sub IndexMatch()

Dim LastRow As Long
    
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

'B20
    Range("J5").FormulaArray = "=iferror(index('All faculties results'!$J:$J,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($J$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("K5").FormulaArray = "=iferror(index('All faculties results'!$K:$K,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($K$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("L5").FormulaArray = "=iferror(index('All faculties results'!$L:$L,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($L$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("J5:J" & LastRow).FillDown
    Range("K5:K" & LastRow).FillDown
    Range("L5:L" & LastRow).FillDown
    
    Range("J5:L" & LastRow).NumberFormat = "dd/mm/yyy"
    Range("N5:P" & LastRow).NumberFormat = "dd/mm/yyy"
    Range("R5:T" & LastRow).NumberFormat = "dd/mm/yyy"
    Range("V5:X" & LastRow).NumberFormat = "dd/mm/yyy"
    Range("Z5:AB" & LastRow).NumberFormat = "dd/mm/yyy"
    Range("AD5:AF" & LastRow).NumberFormat = "dd/mm/yyy"
  
 'B30
    Range("N5").FormulaArray = "=iferror(index('All faculties results'!$J:$J,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($N$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("O5").FormulaArray = "=iferror(index('All faculties results'!$K:$K,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($O$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("P5").FormulaArray = "=iferror(index('All faculties results'!$L:$L,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($P$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("N5:N" & LastRow).FillDown
    Range("O5:O" & LastRow).FillDown
    Range("P5:P" & LastRow).FillDown

'B35
    Range("R5").FormulaArray = "=iferror(index('All faculties results'!$J:$J,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($R$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("S5").FormulaArray = "=iferror(index('All faculties results'!$K:$K,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($S$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("T5").FormulaArray = "=iferror(index('All faculties results'!$L:$L,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($T$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("R5:R" & LastRow).FillDown
    Range("S5:S" & LastRow).FillDown
    Range("T5:T" & LastRow).FillDown
    
 'H20
    Range("V5").FormulaArray = "=iferror(index('All faculties results'!$J:$J,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($V$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("W5").FormulaArray = "=iferror(index('All faculties results'!$K:$K,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($W$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("X5").FormulaArray = "=iferror(index('All faculties results'!$L:$L,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($X$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("V5:V" & LastRow).FillDown
    Range("W5:W" & LastRow).FillDown
    Range("X5:X" & LastRow).FillDown
    
 'J20
    Range("Z5").FormulaArray = "=iferror(index('All faculties results'!$J:$J,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($Z$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("AA5").FormulaArray = "=iferror(index('All faculties results'!$K:$K,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($AA$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("AB5").FormulaArray = "=iferror(index('All faculties results'!$L:$L,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($AB$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("Z5:Z" & LastRow).FillDown
    Range("AA5:AA" & LastRow).FillDown
    Range("AB5:AB" & LastRow).FillDown
    
'P20
    Range("AD5").FormulaArray = "=iferror(index('All faculties results'!$J:$J,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($AD$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("AE5").FormulaArray = "=iferror(index('All faculties results'!$K:$K,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($AE$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("AF5").FormulaArray = "=iferror(index('All faculties results'!$L:$L,match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*($AF$4='All faculties results'!$I:$I),0)),"""")" & _
        ""
    Range("AD5:AD" & LastRow).FillDown
    Range("AE5:AE" & LastRow).FillDown
    Range("AF5:AF" & LastRow).FillDown
    
    Columns("J:AG").Select
    ActiveWindow.DisplayZeros = False

End Sub
 
Sort by date Sort by votes
Sorry I can't see XL2BB in the Add-ins. What other ways for me to share the file and macro with you?
 
Upvote 0

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Apple08 said:
Sorry I can't see XL2BB in the Add-ins. What other ways for me to share the file and macro with you?
Click to expand...
You can upload the file to a file sharing site, and provide a link to it here so that people can download it.
 
Upvote 0
This is what I came up with for you to try:

VBA Code: 
Private Sub IndexMatch()
'
    Dim StartTime               As Double
    StartTime = Timer
'
    Dim LastRow                 As Long
    Dim EndPartOfFormula        As String
    Dim FirstPartOfFormula_1    As String, FirstPartOfFormula_2     As String, FirstPartOfFormula_3     As String
    Dim MidPartOfFormula        As String
'
    LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
'
'------------------------------------------------------------------------------------------------------------------------------------------------
'   Formula section
'
    FirstPartOfFormula_1 = "=iferror(index('All faculties results'!$J:$J"
    FirstPartOfFormula_2 = "=iferror(index('All faculties results'!$K:$K"
    FirstPartOfFormula_3 = "=iferror(index('All faculties results'!$L:$L"
'
        MidPartOfFormula = ",match(1,($D5='All faculties results'!$D:$D)*($E5='All faculties results'!$E:$E)*($H5='All faculties results'!$H:$H)*("
'
        EndPartOfFormula = "='All faculties results'!$I:$I),0)),"""")"
'
'------------------------------------------------------------------------------------------------------------------------------------------------
'
''    Application.ScreenUpdating = False
''    Application.Calculation = xlCalculationManual
'
    Range("M:M,Q:Q,U:U,Y:Y,AC:AC,AG:AG").ClearContents                                              ' Erase contents of various columns
'
'B20
    Range("J5").FormulaArray = FirstPartOfFormula_1 & MidPartOfFormula & "$J$4" & EndPartOfFormula
    Range("K5").FormulaArray = FirstPartOfFormula_2 & MidPartOfFormula & "$K$4" & EndPartOfFormula
    Range("L5").FormulaArray = FirstPartOfFormula_3 & MidPartOfFormula & "$L$4" & EndPartOfFormula
'
'B30
    Range("N5").FormulaArray = FirstPartOfFormula_1 & MidPartOfFormula & "$N$4" & EndPartOfFormula
    Range("O5").FormulaArray = FirstPartOfFormula_2 & MidPartOfFormula & "$O$4" & EndPartOfFormula
    Range("P5").FormulaArray = FirstPartOfFormula_3 & MidPartOfFormula & "$P$4" & EndPartOfFormula
'
'B35
    Range("R5").FormulaArray = FirstPartOfFormula_1 & MidPartOfFormula & "$R$4" & EndPartOfFormula
    Range("S5").FormulaArray = FirstPartOfFormula_2 & MidPartOfFormula & "$S$4" & EndPartOfFormula
    Range("T5").FormulaArray = FirstPartOfFormula_3 & MidPartOfFormula & "$T$4" & EndPartOfFormula
'
'H20
    Range("V5").FormulaArray = FirstPartOfFormula_1 & MidPartOfFormula & "$V$4" & EndPartOfFormula
    Range("W5").FormulaArray = FirstPartOfFormula_2 & MidPartOfFormula & "$W$4" & EndPartOfFormula
    Range("X5").FormulaArray = FirstPartOfFormula_3 & MidPartOfFormula & "$X$4" & EndPartOfFormula
'
'J20
     Range("Z5").FormulaArray = FirstPartOfFormula_1 & MidPartOfFormula & "$Z$4" & EndPartOfFormula
    Range("AA5").FormulaArray = FirstPartOfFormula_2 & MidPartOfFormula & "$AA$4" & EndPartOfFormula
    Range("AB5").FormulaArray = FirstPartOfFormula_3 & MidPartOfFormula & "$AB$4" & EndPartOfFormula
'
'P20
    Range("AD5").FormulaArray = FirstPartOfFormula_1 & MidPartOfFormula & "$AD$4" & EndPartOfFormula
    Range("AE5").FormulaArray = FirstPartOfFormula_2 & MidPartOfFormula & "$AE$4" & EndPartOfFormula
    Range("AF5").FormulaArray = FirstPartOfFormula_3 & MidPartOfFormula & "$AF$4" & EndPartOfFormula
'
    Range("J5:AF5").AutoFill Range("J5:AF" & LastRow)                                                   ' Drag the formulas down
'
      Range("J5:L" & LastRow).NumberFormat = "dd/mm/yyy"
      Range("N5:P" & LastRow).NumberFormat = "dd/mm/yyy"
      Range("R5:T" & LastRow).NumberFormat = "dd/mm/yyy"
      Range("V5:X" & LastRow).NumberFormat = "dd/mm/yyy"
     Range("Z5:AB" & LastRow).NumberFormat = "dd/mm/yyy"
    Range("AD5:AF" & LastRow).NumberFormat = "dd/mm/yyy"
'
    Columns("J:AG").Select
    ActiveWindow.DisplayZeros = False
'
''    Application.Calculation = xlCalculationAutomatic
''    Application.ScreenUpdating = True
'
    Debug.Print "Time to complete = " & Timer - StartTime & " seconds."                                 ' Display the Time to complete in the 'Immediate'
'                                                                                                       '       window (CTRL+G)
    MsgBox "Completed."                                                                                 ' Let user know the process has completed
End Sub

Should be way easier for you to make the edits to the range lengths that @Joe4 suggested in post #2 suggestion 2.
 
Upvote 0
I have updated that link with new updated file.
Try this code
VBA Code: 
Option Explicit
Sub test()
Dim lr&, i&, j&, k&, rng1, rng2
With Worksheets("All faculties results")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng1 = .Range("D12:M" & lr).Value2
End With
With Worksheets("Report")
    lr = .Cells(Rows.Count, "D").End(xlUp).Row
    rng2 = .Range("D3:AG" & lr).Value
    For i = 3 To UBound(rng2)
        For k = 2 To UBound(rng1)
            If rng2(i, 1) & rng2(i, 2) & rng2(i, 5) = rng1(k, 1) & rng1(k, 2) & rng1(k, 5) Then
                For j = 7 To UBound(rng2, 2)
                    If rng2(2, j) = rng1(k, 6) Then
                        Select Case rng2(1, j)
                            Case Is = rng1(1, 7)
                                rng2(i, j) = rng1(k, 7)
                            Case Is = rng1(1, 8)
                                rng2(i, j) = rng1(k, 8)
                            Case Is = rng1(1, 9)
                                rng2(i, j) = rng1(k, 9)
                        End Select
                    End If
                Next
            End If
        Next
    Next
    .Range("D3:AG" & lr).Value = rng2
    For i = 7 To 29
        If InStr(1, "-10-14-18-22-26-", "-" & i & "-") = 0 Then
            .Range("D5:AG" & lr).Columns(i).NumberFormat = "dd/mm/yyyy"
        End If
    Next
End With
End Sub
 
Upvote 0
Solution
Thank you JohnnyL and Bebo021999. I did try both macros, they both worked well.

Bebo's macro likes a magic it only took a few minutes to finish running the report. This is amazing as it always took me more than 3 hours for the macro running. Therefore I will take Bebo's macro as the solution.

Many thanks for everyone who has contributed in my macro issue. You are all amazing and so helpful. :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Solved
Insert formula in range of cells through VBA Code
2
Replies
13
Views
124
hrayani
H
B
  • Question Question
Extract Information From String
Replies
4
Views
100
Blessy Clara
B
L
  • Solved
FILTER Between two numbers
Replies
4
Views
125
StephenCrump
S
D
  • Question Question
If formula with date & VLOOKUP
Replies
1
Views
319
etaf
etaf
S
  • Question Question
Auto Sorting League Table
Replies
2
Views
701
arun_eagertolearn
A

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top