Results 1 to 6 of 6

Improve speed of For each loop

This is a discussion on Improve speed of For each loop within the Excel Questions forums, part of the Question Forums category; Hi, I am currently working on the below a macro that loops through a range and inserts a formula depending ...

  1. #1
    New Member
    Join Date
    Mar 2017
    Posts
    5

    Default Improve speed of For each loop

    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

  2. #2
    Board Regular tonyyy's Avatar
    Join Date
    Jun 2015
    Location
    Grants Pass, Oregon
    Posts
    1,032

    Default Re: Improve speed of For each loop

    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 by tonyyy; Mar 17th, 2017 at 03:18 PM.
    Windoze 7 / Excel 2010

    How to paste your Excel data with Excel Jeanie
    How to post your vba code

  3. #3
    New Member
    Join Date
    Mar 2017
    Posts
    5

    Default Re: Improve speed of For each loop

    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

  4. #4
    Board Regular tonyyy's Avatar
    Join Date
    Jun 2015
    Location
    Grants Pass, Oregon
    Posts
    1,032

    Default Re: Improve speed of For each loop

    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).Formula = arr2(i)
    '        ws1.Range(ws1.Cells(4, 10), ws1.Cells(195, 10)).SpecialCells(xlCellTypeVisible).FormulaArray = arr2(i)
        End With
    Next i
    ws1.AutoFilterMode = False
    ws1.Range(Cells(4, 10), Cells(195, 10)).FormulaArray = ws1.Range(Cells(4, 10), Cells(195, 10)).Formula
    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.
    Windoze 7 / Excel 2010

    How to paste your Excel data with Excel Jeanie
    How to post your vba code

  5. #5
    New Member
    Join Date
    Mar 2017
    Posts
    5

    Default Re: Improve speed of For each loop

    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

  6. #6
    Board Regular tonyyy's Avatar
    Join Date
    Jun 2015
    Location
    Grants Pass, Oregon
    Posts
    1,032

    Default Re: Improve speed of For each loop

    Glad you found a solution, ovikstrom. Thanks for the feedback.
    Windoze 7 / Excel 2010

    How to paste your Excel data with Excel Jeanie
    How to post your vba code

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com