Improve speed of For each loop

ovikstrom

New Member
Joined
Mar 2, 2017
Messages
5
Hi,

I am currently working on the below a macro that loops through a range and inserts a formula depending on the value of a cell outside of the range. I am running about 5 of these in the same macro and the work fine, but the time to execute is quite long (1.5min). I am looking to run this frequently throughout the day and I was wondering if there are any suggestions on how I can speed it up?

Code:
Sub improvedmacro()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
 
For Each c In Worksheets("Fund Data").Range("J4:J195").Cells

If c.Offset(0, -6).Value = "Lux" Then
    c.FormulaArray = "=INDEX('Lux Data'!C[-9]:C[-1],MATCH(1,('Lux Data'!C[-9]=RC[-5])*('Lux Data'!C[-7]=RC[-4])*('Lux Data'!C[-2]=""NET SHARES OUTSTANDING""),0),9)"
ElseIf c.Offset(0, -6).Value = "Ire" Then
    c.FormulaArray = "=INDEX('Irish Data'!C[-9]:C[-1],MATCH(1,('Irish Data'!C[-9]=RC[-5])*('Irish Data'!C[-7]=RC[-4])*('Irish Data'!C[-2]=""NET SHARES OUTSTANDING""),0),9)"
ElseIf c.Offset(0, -6).Value = "CH" Then
            c.FormulaR1C1 = "=VLOOKUP(RC3,'Swiss NAV'!R1C2:R23C21,12,FALSE)"
End If
Next
End Sub


I appreciate any ideas you might have.



Many thanks,
OVikstrom
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
OVikstrom,

Welcome to the Board.

Rather than loop through each cell, another approach would be to filter the range then fill the visible cells...

Code:
Sub FilterFill()
'Assumes headers in Row 3
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Dim ws1 As Worksheet
Dim arr1() As Variant, arr2() As Variant
Dim i As Long
Set ws1 = Sheets("Fund Data")
arr1 = Array("Lux", "Ire", "CH")
arr2 = Array( _
        "=INDEX('Lux Data'!C[-9]:C[-1],MATCH(1,('Lux Data'!C[-9]=RC[-5])*('Lux Data'!C[-7]=RC[-4])*('Lux Data'!C[-2]=""NET SHARES OUTSTANDING""),0),9)", _
        "=INDEX('Irish Data'!C[-9]:C[-1],MATCH(1,('Irish Data'!C[-9]=RC[-5])*('Irish Data'!C[-7]=RC[-4])*('Irish Data'!C[-2]=""NET SHARES OUTSTANDING""),0),9)", _
        "=VLOOKUP(RC3,'Swiss NAV'!R1C2:R23C21,12,FALSE)")

For i = 0 To UBound(arr1)
    If ws1.AutoFilterMode = True Then ws1.AutoFilterMode = False
    With ws1.Range(Cells(3, 4), Cells(195, 10))
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:=arr1(i)
        ws1.Range(Cells(4, 10), Cells(195, 10)).SpecialCells(xlCellTypeVisible).Value = arr2(i)
    End With
Next i
ws1.AutoFilterMode = False
End Sub

Cheers,

tonyyy
 
Last edited:
Upvote 0
Hi Tonyyy,

Thank you very much for the welcome and the help on the macro. This approach is lightning speed fast, it works well. However, for the Index and Match formulas I get a #N/A in the cell even though the formula is correct. I am guessing this is because I need to use "FormulaArray" rather than "Array". But when I try to change arr2 = FormulaArray ( .....) I get a "Sub or function not defined" error. Do you know a way around this?

Many thanks again,
ovikstrom
 
Upvote 0
Code:
Sub FilterFill()
'Assumes headers in Row 3
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Dim ws1 As Worksheet
Dim arr1() As Variant, arr2() As Variant
Dim i As Long

Set ws1 = Sheets("Fund Data")
arr1 = Array("Lux", "Ire", "CH")
arr2 = Array( _
        "=INDEX('Lux Data'!C[-9]:C[-1],MATCH(1,('Lux Data'!C[-9]=RC[-5])*('Lux Data'!C[-7]=RC[-4])*('Lux Data'!C[-2]=""NET SHARES OUTSTANDING""),0),9)", _
        "=INDEX('Irish Data'!C[-9]:C[-1],MATCH(1,('Irish Data'!C[-9]=RC[-5])*('Irish Data'!C[-7]=RC[-4])*('Irish Data'!C[-2]=""NET SHARES OUTSTANDING""),0),9)", _
        "=VLOOKUP(RC3,'Swiss NAV'!R1C2:R23C21,12,FALSE)")

For i = 0 To UBound(arr1)
    If ws1.AutoFilterMode = True Then ws1.AutoFilterMode = False
    With ws1.Range(ws1.Cells(3, 4), ws1.Cells(195, 10))
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:=arr1(i)
        ws1.Range(Cells(4, 10), Cells(195, 10)).SpecialCells(xlCellTypeVisible).[COLOR=#ff0000]Formula [/COLOR]= arr2(i)
'        ws1.Range(ws1.Cells(4, 10), ws1.Cells(195, 10)).SpecialCells(xlCellTypeVisible).FormulaArray = arr2(i)
    End With
Next i
ws1.AutoFilterMode = False
[COLOR=#ff0000]ws1.Range(Cells(4, 10), Cells(195, 10)).FormulaArray = ws1.Range(Cells(4, 10), Cells(195, 10)).Formula[/COLOR]
End Sub

So... I tried first to use the line that's commented out, thinking that a Range.FormulaArray construct would work. Unfortunately, .FormulaArray doesn't like SpecialCells - at least I can't get it to work - so I opted for the solution in red. Sadly this is much slower, but may be incrementally faster than looping.
 
Upvote 0
Tonyyy, thanks for the help. Unfortunately that solution was pretty much the same speed as the original one. However, I was able to swap the INDEX & MATCH formula to a SUMIFS which does not require the .FormulaArray, due to the fact that all combinations are unique it seems to work well.

Code:
Sub FilterFill()
'Assumes headers in Row 3
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Dim ws1 As Worksheet
Dim arr1() As Variant, arr2() As Variant
Dim i As Long
Set ws1 = Sheets("Fund Data")
arr1 = Array("Lux", "Ire", "CH")
arr2 = Array( _
        "=SUMIFS('Lux Data'!C[-2],'Lux Data'!C[-10],INDIRECT(""RC[-6]"",FALSE),'Lux Data'!C[-8],INDIRECT(""RC[-5]"",FALSE),'Lux Data'!C[-3],""NET SHARES OUTSTANDING"")", _
        "=SUMIFS('Irish Data'!C[-2],'Irish Data'!C[-10],INDIRECT(""RC[-6]"",FALSE),'Irish Data'!C[-8],INDIRECT(""RC[-5]"",FALSE),'Irish Data'!C[-3],""NET SHARES OUTSTANDING"")", _
        "=VLOOKUP(RC3,'Swiss NAV'!R1C2:R23C21,12,FALSE)")
For i = 0 To UBound(arr1)
    If ws1.AutoFilterMode = True Then ws1.AutoFilterMode = False
    With ws1.Range(Cells(3, 4), Cells(195, 11))
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:=arr1(i)
        ws1.Range(Cells(4, 11), Cells(195, 11)).SpecialCells(xlCellTypeVisible).Value = arr2(i)
       ' ws1.Range(Cells(4, 10), Cells(195, 10)).SpecialCells(xlCellTypeVisible).Value = ws1.Range(Cells(4, 10), Cells(195, 10)).SpecialCells(xlCellTypeVisible).FormulaArray
    End With
Next i
ws1.AutoFilterMode = False
End Sub
 
Upvote 0
Glad you found a solution, ovikstrom. Thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,205
Members
448,554
Latest member
Gleisner2

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