Help speed up "change font color" routine

[EssKayKay]

Hello,

I’ve asked a similar question a while ago regarding this. I wanted to change the font display based on the status of a different cell in the same row. If the value in column “M” is greater than zero (date), then apply the change to the corresponding cell in column “I” in the same row accordingly.

A kind member assisted with my request and provided me with the following code which does what I had in mind. However, there is one thing I’m noticing. As the worksheet becomes more populated the routine slows down considerably (i.e., from a couple seconds up to 40+ seconds).

myLastRow = Cells(Rows.Count, "M").End(xlUp).Row
For i = 33 To myLastRow
  If Cells(i, "M").Value > 0 Then
    Range(Cells(i, "I"), Cells(i, "I")).Locked = True
    Range(Cells(i, "I"), Cells(i, "I")).Font.Bold = False
    Range(Cells(i, "I"), Cells(i, "I")).Font.Color = 0
  End If
Next i

After some testing, it appears the operation that is causing the bulk of this is changing the color.
Range(Cells(i, "I"), Cells(i, "I")).Font.Color = 0
If I remove that line the routine runs much faster – still slows down as the worksheet becomes more populated but better than when including changing the font color. The total number of rows could be 2000 (I33:I2033) although that many is quite doubtful – more like less than 800.

Any suggestions which may help this would be appreciated.

Thanks for viewing,
Steve K.

 

[Sergius]

Add these lines

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

after the variable declaration
And before End Sub add these lines

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

This should speed up the code execution.

 

[MARK858]

A bit puzzled why you would use Range(Cells(i, "I"), Cells(i, "I"))
for a single cell but anyway try the code below

Sub Filterit()
    Application.ScreenUpdating = False
   
    With Range("M32:M" & Range("M" & Rows.Count).End(xlUp).Row)
   
        .AutoFilter 1, ">0"
       
        On Error Resume Next
        With .Offset(1, -4).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            .Locked = True
            .Font.Bold = False
            .Font.Color = 0
            .AutoFilter
        End With
        On Error GoTo 0
    
   
    End With
   
    Application.ScreenUpdating = True
End Sub

 

[EssKayKay]

A bit puzzled why you would use Range(Cells(i, "I"), Cells(i, "I"))
for a single cell but anyway try the code below

Sub Filterit()
    Application.ScreenUpdating = False
  
    With Range("M32:M" & Range("M" & Rows.Count).End(xlUp).Row)
  
        .AutoFilter 1, ">0"
      
        On Error Resume Next
        With .Offset(1, -4).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            .Locked = True
            .Font.Bold = False
            .Font.Color = 0
            .AutoFilter
        End With
        On Error GoTo 0
   
  
    End With
  
    Application.ScreenUpdating = True
End Sub

Thank you Mark for your quick response. This is working much better. I have one more routine that reacts similarly. I will look at your code and see if I can modify my other routine to work better.

Again, much appreciated,
Steve K.

 

[MARK858]

You're welcome (@EssKayKay btw, you have marked post 2 as the solution, are you sure that is correct?)

 

[EssKayKay]

Add these lines

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

after the variable declaration
And before End Sub add these lines

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

This should speed up the code execution.

Actually I did have that in my code. I should have noted that - sorry.