VBA Help

THRASHER69 · Mar 17, 2020

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

Joe4 · Mar 25, 2020

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.

THRASHER69 · Mar 25, 2020

It will be option 1, ran on a sheet with existing data only

Joe4 · Mar 25, 2020

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

rlv01 · Mar 25, 2020

THRASHER69 said:
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

THRASHER69 · Mar 25, 2020

rlv01,
I didn't notice any change in the speed

THRASHER69 · Mar 25, 2020

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

Fluff · Mar 25, 2020

As a matter of interest, how many rows of data do you normally have?

THRASHER69 · Mar 25, 2020

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

Fluff · Mar 25, 2020

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.

THRASHER69 · Mar 25, 2020

how weird. I wonder why it would take so long for me?

VBA Help

THRASHER69

Board Regular

Joe4

MrExcel MVP, Junior Admin

Excel Facts

THRASHER69

Board Regular

Joe4

MrExcel MVP, Junior Admin

rlv01

Well-known Member

THRASHER69

Board Regular

THRASHER69

Board Regular

Fluff

MrExcel MVP, Moderator

THRASHER69

Board Regular

Fluff

MrExcel MVP, Moderator

THRASHER69

Board Regular

Similar threads

Forum statistics

Share this page

VBA Help

Board Regular

MrExcel MVP, Junior Admin

Excel Facts

Board Regular

MrExcel MVP, Junior Admin

Well-known Member

Board Regular

Board Regular

MrExcel MVP, Moderator

Board Regular

MrExcel MVP, Moderator

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock