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

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
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

I
  • Question
Return a value over a number of columns
Replies
4
Views
95
ianxv1100
I
T
  • Question
Record consolidation
2
Replies
11
Views
626
Fluff
Fluff
T
  • Question
Pull data from multiple sheets that match varying criteria
Replies
1
Views
209
bobaol
B
G
  • Question
Workbook formulas copied with Sheet references in new Workbook
Replies
0
Views
98
GK039
G
K
  • Solved
Question Only? why one vba code works and another wont, even though should have same results.
Replies
3
Views
146
MARK858
MARK858

Forum statistics

Threads
1,216,586
Messages
6,131,571
Members
449,655
Latest member
Anil K Sonawane

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