VBA Help

THRASHER69

Board Regular
Joined
Mar 29, 2012
Messages
200
Hello,

I'm hoping some one can help me out. The part of my code listed below really seems to slow my macro down. Anyone know a better way to write this to make it run faster?

VBA Code:
    Set iRow = Range("I2", Range("I2").End(xlDown))

    With iRow
        .FormatConditions.Add Type:=xlExpression, Formula1:= _ 
           "=IF($I2<$G2,TRUE,FALSE)"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = vbYellow
                .TintAndShade = 0
            End With
        End With
    End With

    Set iRow1 = Range("J2", Range("J2").End(xlDown))

    With iRow1
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($J2<$G2,TRUE,FALSE)"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = vbYellow
                .TintAndShade = 0
            End With
        End With
    End With
    
    Set iRow2 = Range("C2", Range("C2").End(xlDown))

    With iRow2
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF(N2=""Released to Warehouse"",TRUE,FALSE)" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 22
                .TintAndShade = 0
            End With
        End With
    End With
    
    Set iRow3 = Range("E2", Range("E2").End(xlDown))

    With iRow3
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF(N2=""Released to Warehouse"",TRUE,FALSE)" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 22
                .TintAndShade = 0
            End With
        End With
    End With
    
    Set iRow4 = Range("N2", Range("N2").End(xlDown))

    With iRow4
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF(N2=""Released to Warehouse"",TRUE,FALSE)" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 22
                .TintAndShade = 0
            End With
        End With
    End With
    
    Set iRow5 = Range("C1")

    With iRow5
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=COUNTIF(N:N,""Released to Warehouse"")"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 22
                .TintAndShade = 0
            End With
        End With
    End With
    
    Set iRow6 = Range("E1") 

    With iRow6
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=COUNTIF(N:N,""Released to Warehouse"")" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 22
                .TintAndShade = 0
            End With
        End With
    End With
    
    Set iRow7 = Range("D2", Range("D2").End(xlDown)) 

    With iRow7
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($N2=""Staged/Pick Confirmed"",TRUE,FALSE)" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 4
                .TintAndShade = 0
            End With
        End With
    End With
    
     Set iRow8 = Range("N2", Range("N2").End(xlDown))

    With iRow8
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($N2=""Staged/Pick Confirmed"",TRUE,FALSE)"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 4
                .TintAndShade = 0
            End With
        End With
    End With
    
    Set iRow9 = Range("C2", Range("C2").End(xlDown))

    With iRow9
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($O2=TODAY(),TRUE,FALSE)" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 43
                .TintAndShade = 0
            End With
        End With
    End With
    
    Set iRow10 = Range("O2", Range("O2").End(xlDown)) 

    With iRow10
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($O2=TODAY(),TRUE,FALSE)"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 43
                .TintAndShade = 0
            End With
        End With
    End With
    
    Set iRow11 = Range("A2", Range("A2").End(xlDown)) 

    With iRow11
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($P2<>"""",TRUE,FALSE)"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 35
                .TintAndShade = 0
            End With
        End With
    End With
    
    LastRow3 = Cells(Rows.Count, "F").End(xlUp).Row 
    
    Set iRow12 = Range("P2:P" & LastRow3)

    With iRow12
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($P2<>"""",TRUE,FALSE)"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 35
                .TintAndShade = 0
            End With
        End With
    End With
    
    Set iRow13 = Range("B1")

    With iRow13
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=COUNTIF(B:B,""1320 EAST LOS ANGELES AVENUE,SHAFTER,CA,93263,US"")"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow13
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=COUNTIF(B:B,""10353 RICHMOND AVENUE,HOUSTON,TX,77042,US"")"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow13
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=COUNTIF(B:B,""19417 COLOMBO STREET,BAKERSFIELD,CA,93308,US"")" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow13
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=COUNTIF(B:B,""2040 OREGON STREET,ODESSA,TX,79764,US"")"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow13
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=COUNTIF(B:B,""1444 NORTH DERRICK DRIVE,CASPER,WY,82604,US"")" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow13
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=COUNTIF(B:B,""10906 FM 2920 ROAD,TOMBALL,TX,77375,US"")" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow13
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=COUNTIF(B:B,""21255 LA HIGHWAY 1 SOUTH,PLAQUEMINE,LA,70764,US"")" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow13
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=COUNTIF(B:B,""9870 EAST 30TH STREET,INDIANAPOLIS,IN,46229,US"")"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow13
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=COUNTIF(B:B,""8708 WEST LITTLE YORK,SUITE 100,HOUSTON,TX,77040,US"")" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    Set iRow14 = Range("B2", Range("B2").End(xlDown))

    With iRow14
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($B2=""1320 EAST LOS ANGELES AVENUE,SHAFTER,CA,93263,US"",TRUE,FALSE)"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow14
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($B2=""10353 RICHMOND AVENUE,HOUSTON,TX,77042,US"",TRUE,FALSE)" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow14
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($B2=""19417 COLOMBO STREET,BAKERSFIELD,CA,93308,US"",TRUE,FALSE)" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow14
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($B2=""2040 OREGON STREET,ODESSA,TX,79764,US"",TRUE,FALSE)"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow14
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($B2=""1444 NORTH DERRICK DRIVE,CASPER,WY,82604,US"",TRUE,FALSE)" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow14
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($B2=""10906 FM 2920 ROAD,TOMBALL,TX,77375,US"",TRUE,FALSE)" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow14
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($B2=""21255 LA HIGHWAY 1 SOUTH,PLAQUEMINE,LA,70764,US"",TRUE,FALSE)" 
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow14
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($B2=""9870 EAST 30TH STREET,INDIANAPOLIS,IN,46229,US"",TRUE,FALSE)"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With
    
    With iRow14
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF($B2=""8708 WEST LITTLE YORK SUITE 100,HOUSTON,TX,77040,US"",TRUE,FALSE)"
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 8
                .TintAndShade = 0
            End With
        End With
    End With

Thank you
 
OK, I might have made an assumption there. So, let's take a step back and clarify its use first.
Is this intended to be run on:
1. A sheet with existing data only
2. A template sheet where users will be entering in new data
3. A sheet with existing data where users may be editing/adding data?

The answer to that question will determine what kind of VBA code we need, whether we need one-time run VBA code, dynamic event procedure VBA code, or a combination of the two.
 
Upvote 0

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
OK, so then we wouldn't use a Worksheet_Change event procedure code, because that is designed to run as data is entered. Rather, we would just create one time code to run through all your data and do the highlighting you want. Will it be any faster? I don't know, you would have to test it out. But it is only a one-time thing. You just run the code once, and then everything is hard-coded, and there is running code or Conditional Formatting to slow down the Workbook after that.

So, that code would look something like this (with the code for your column I formatting done):
VBA Code:
Sub FormatColumn()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.PrintCommunication = False
    
'   Format column I
    Dim iRow As Range
    Dim cell As Range
    
    Set iRow = Range("I2", Range("I2").End(xlDown))
    
'   Loop through all cells in iRow
    For Each cell In iRow
'       Compare value in column I to value in column G of same row
        If cell < cell.Offset(0, -2) Then
            cell.Interior.Color = vbYellow
        End If
    Next cell
    
'   Do rest of columns below
'   ...
    
    Application.PrintCommunication = True
    Application.EnableEvents = True
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub
 
Upvote 0
rlv01,
The code runs only once for the sheet ran fresh daily.

Just out of curiosity, if you add the new housekeeping statement just below the very first range "set" statement, does your code run any faster?
VBA Code:
    Set iRow = Range("I2", Range("I2").End(xlDown))
    iRow.Parent.UsedRange.FormatConditions.Delete '<--- New
 
Upvote 0
Joe4,
Just so I make sure I'm doing this correctly, this part of the code:
VBA Code:
Set iRow3 = Range("E2", Range("E2").End(xlDown))  

    With iRow3
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=IF(N2=""Released to Warehouse"",TRUE,FALSE)"  
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ColorIndex = 22
                .TintAndShade = 0
            End With
        End With
    End With
would change to this correct?
VBA Code:
Set iRow3 = Range("E2", Range("E2").End(xlDown))
    
'   Loop through all cells in iRow3
    For Each cell In iRow3
        If cell = ""Released to Warehouse"" Then
            cell.Interior.ColorIndex = 22
        End If
    Next cell
 
Upvote 0
As a matter of interest, how many rows of data do you normally have?
 
Upvote 0
The one Today has 814 rows but it varies greatly depending on business. We are pretty slow right now but I have seen it over 2,000 rows in the past
 
Upvote 0
I just tested your code on ~8800 rows & it took less than half a second. Whilst the time will probably vary depending on how many cells need to be filled, I wouldn't expect it to take more than 1 or maybe 2 seconds at most.
 
Upvote 0

Forum statistics

Threads
1,223,445
Messages
6,172,177
Members
452,446
Latest member
walkman99

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