Making For Each loop faster

Matthewious2016

New Member
Joined
Jun 27, 2016
Messages
13
Code:
Sub GetPlanFormula()
    Dim PlanRange, iCell As Range
    
    Set PlanRange = _
        shMainPage.Range("E6:F8,E10:F17,E19:F26,E28:F32,E34:F38,E40:F46,E48:F48,E50:F50,E52:F52,E54:F56,E58:F58,E60:F60,E62:F62,E64:F69,E71:F74")
    
    For Each iCell In PlanRange
        
        Range("E6").FormulaR1C1 = _
            "=IFERROR(INDEX('Plan'!R6C8:R77C43,MATCH(R6C3&""-""&R6C4,INDEX(RIGHT('Plan'!R6C4:R77C4,LEN('Plan'!R6C4:R77C4)-2)&""-""&'Plan'!R6C7:R77C7,0),0),MATCH(""*W""&R4C6,'Plan'!R5C8:R5C43,0)),0)"
        Range("G6").FormulaR1C1 = "=SUM(R6C5:R6C6)"
        
        Range("E7").FormulaR1C1 = _
            "=IFERROR(INDEX('Plan'!R6C8:R77C43,MATCH(R7C3&""-""&R7C4,INDEX(RIGHT('Plan'!R6C4:R77C4,LEN('Plan'!R6C4:R77C4)-2)&""-""&'Plan'!R6C7:R77C7,0),0),MATCH(""*W""&R4C6,'Plan'!R5C8:R5C43,0)),0)"
        Range("G7").FormulaR1C1 = "=SUM(R7C5:R7C6)"
        
        Range("E8").FormulaR1C1 = _
            "=IFERROR(INDEX('Plan'!R6C8:R77C43,MATCH(R8C3&""-""&R8C4,INDEX(RIGHT('Plan'!R6C4:R77C4,LEN('Plan'!R6C4:R77C4)-2)&""-""&'Plan'!R6C7:R77C7,0),0),MATCH(""*W""&R4C6,'Plan'!R5C8:R5C43,0)),0)"
        Range("G8").FormulaR1C1 = "=SUM(R8C5:R8C6)"
        
        
        Range("F10").FormulaR1C1 = _
            "=IFERROR(INDEX('Plan'!R6C8:R77C43,MATCH(R10C3&""-""&R10C4,INDEX(RIGHT('Plan'!R6C4:R77C4,LEN('Plan'!R6C4:R77C4)-2)&""-""&'Plan'!R6C7:R77C7,0),0),MATCH(""*W""&R4C6,'Plan'!R5C8:R5C43,0)),0)"
        Range("G10").FormulaR1C1 = "=SUM(R10C5:R10C6)"
        
        Range("F11").FormulaR1C1 = _
            "=IFERROR(INDEX('Plan'!R6C8:R77C43,MATCH(R11C3&""-""&R11C4,INDEX(RIGHT('Plan'!R6C4:R77C4,LEN('Plan'!R6C4:R77C4)-2)&""-""&'Plan'!R6C7:R77C7,0),0),MATCH(""*W""&R4C6,'Plan'!R5C8:R5C43,0)),0)"
        Range("G11").FormulaR1C1 = "=SUM(R11C5:R11C6)"
        
        Range("F12").FormulaR1C1 = _
            "=IFERROR(INDEX('Plan'!R6C8:R77C43,MATCH(R12C3&""-""&R12C4,INDEX(RIGHT('Plan'!R6C4:R77C4,LEN('Plan'!R6C4:R77C4)-2)&""-""&'Plan'!R6C7:R77C7,0),0),MATCH(""*W""&R4C6,'Plan'!R5C8:R5C43,0)),0)"
        Range("G12").FormulaR1C1 = "=SUM(R12C5:R12C6)"
        
        Range("F13").FormulaR1C1 = _
            "=IFERROR(INDEX('Plan'!R6C8:R77C43,MATCH(R13C3&""-""&R13C4,INDEX(RIGHT('Plan'!R6C4:R77C4,LEN('Plan'!R6C4:R77C4)-2)&""-""&'Plan'!R6C7:R77C7,0),0),MATCH(""*W""&R4C6,'Plan'!R5C8:R5C43,0)),0)"
        Range("G13").FormulaR1C1 = "=SUM(R13C5:R13C6)"
        
        Range("F14").FormulaR1C1 = _
            "=IFERROR(INDEX('Plan'!R6C8:R77C43,MATCH(R14C3&""-""&R14C4,INDEX(RIGHT('Plan'!R6C4:R77C4,LEN('Plan'!R6C4:R77C4)-2)&""-""&'Plan'!R6C7:R77C7,0),0),MATCH(""*W""&R4C6,'Plan'!R5C8:R5C43,0)),0)"
        Range("G14").FormulaR1C1 = "=SUM(R14C5:R14C6)"
        
        Range("F15").FormulaR1C1 = _
            "=IFERROR(INDEX('Plan'!R6C8:R77C43,MATCH(R15C3&""-""&R15C4,INDEX(RIGHT('Plan'!R6C4:R77C4,LEN('Plan'!R6C4:R77C4)-2)&""-""&'Plan'!R6C7:R77C7,0),0),MATCH(""*W""&R4C6,'Plan'!R5C8:R5C43,0)),0)"
        Range("G15").FormulaR1C1 = "=SUM(R15C5:R15C6)"
        
        Range("F16").FormulaR1C1 = _
            "=IFERROR(INDEX('Plan'!R6C8:R77C43,MATCH(R16C3&""-""&R16C4,INDEX(RIGHT('Plan'!R6C4:R77C4,LEN('Plan'!R6C4:R77C4)-2)&""-""&'Plan'!R6C7:R77C7,0),0),MATCH(""*W""&R4C6,'Plan'!R5C8:R5C43,0)),0)"
        Range("G16").FormulaR1C1 = "=SUM(R16C5:R16C6)"
        
        Range("F17").FormulaR1C1 = _
            "=IFERROR(INDEX('Plan'!R6C8:R77C43,MATCH(R17C3&""-""&R17C4,INDEX(RIGHT('Plan'!R6C4:R77C4,LEN('Plan'!R6C4:R77C4)-2)&""-""&'Plan'!R6C7:R77C7,0),0),MATCH(""*W""&R4C6,'Plan'!R5C8:R5C43,0)),0)"
        Range("G17").FormulaR1C1 = "=SUM(R17C5:R17C6)"
        
        If IsEmpty(iCell) Then
            PlanRange.Value = "--"
        End If
    Next iCell
End Sub

As I got a pretty long VBA code for the code above. I only get some of the codes to show. May I know how to make the code a little bit faster than before?
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
turn off screenupdating

application.screeupdating = false

turn of calculation

application.calculation = xlcalculationmanual

before you start to use your code, then turn it back on at the end of the code
 
Upvote 0
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim iCell, rngCheck As Range
    
    Set rngCheck = ActiveSheet.Range _
        ("E6:L8,E10:L17,E19:L26,E28:L32,E34:L38,E40:L46,E48:L48,E50:L50,E52:L52,E54:L56,E58:L58,E60:L60,E62:L62,E64:L69,E71:L74")
    For Each iCell In rngCheck
        'Cell's value are not equals to zero, font color is black in color '(Other Numbers)'
        If iCell.Value <> 0 Then iCell.Font.Color = RGB(0, 0, 0)
        'Cell's value less than 1, font color will be grey in color '(0)'
        If iCell.Value < 1 Then iCell.Font.Color = RGB(150, 150, 150)
    Next iCell
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Is there anyway to like it will check every instance that the cell will changed to another value then change the colour by itself? I have tried Worksheet_Change() but it load until halfway it hangs and force exit the program.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,264
Messages
6,171,081
Members
452,377
Latest member
bradfordsam

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