Slow code

[InaCell]

Hi

I have some code that works in 2 parts and is separated into 2 macros that are both called from a third.

The first macro selects the cells and clears the data within. These cells contain a formula which displays either TRUE or FALSE.

The second macro selects the cells and removes/clears the background colour if it exists.

Problem. The code is extremely slow. Could anyone improve the speed?

Sub RemoveCode()
    Application.ScreenUpdating = False ' speed up code for macro
        Call RemoveTrueFalse
        Call RemoveColour
    Application.ScreenUpdating = True ' set back to normal
End Sub
Sub RemoveTrueFalse()
Dim x As Long, a As Long, b As Long
    Application.ScreenUpdating = False ' speed up code for macro
Application.EnableEvents = False
    For a = 3 To 27 Step 3 'selects columns C F I L O R U
        x = Cells(Rows.Count, a).End(xlUp).Row ' sets last row of source range
        For b = 7 To x    'source range starts at row 7 & goes to bottom
                Cells(b, a).Value = "" 'remove all data from cell
     
        Next b 'goes to next Row in source sheet
    Next a 'goes to next Col in source sheet
Application.EnableEvents = True
    Application.ScreenUpdating = True ' set back to normal
End Sub
Sub RemoveColour()
Dim x As Long, a As Long, b As Long
    Application.ScreenUpdating = False ' speed up code for macro
Application.EnableEvents = False
    For a = 1 To 25 Step 3 'selects columns A D G J M P S
        x = Cells(Rows.Count, a).End(xlUp).Row ' sets last row of source range
        For b = 7 To x    'source range starts at row 7 & goes to bottom
    Cells(b, a).Select
       With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
         Next b 'goes to next Row in source sheet
    Next a 'goes to next Col in source sheet
Application.EnableEvents = True
    Application.ScreenUpdating = True ' set back to normal
End Sub

Thanks

 

[GlennUK]

Why do each cell separately from 7 to x? That is a contiguous range, so you can change the contents and formats in a single command instead of a loop.

 

[InaCell]

Hi Glenn

Thanks for all your assistance on my previous questions.

In this instance each "format" is in a different column. ie colours are in col A D G J M P S, while the formula is in Col C F I L O R U.

I am modifying some existing code that I had used and worked my head around. I am a bit lost on how to change it. Yes, it is contiguous but would I then have to do it for each col?

Thanks

Bernie

 

[GlennUK]

It was my pleasure to help last time.

For your current problem ... sure you need to loop for each column, but then you are looping through each cell in that column from row 7 to x, when that chunk of cells is all in one lump ... i.e. don't do the 7 to x loop, just set the range to modify at that point. Like:

        x = Cells(Rows.Count, a).End(xlUp).Row ' sets last row of source range
     With Range(Cells(7, a),Cells(x,a)).Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

... at a guess.

 

[InaCell]

Have modified code but still seems slow. Will have another look.

 

[InaCell]

Have changed both macros so that each cell is not looped but each col in turn. Code still runs very slow.

Sub RemoveCode()
    Application.ScreenUpdating = False ' speed up code for macro
    Application.EnableEvents = False
        Call RemoveTrueFalse
        Call RemoveColour
    Application.EnableEvents = True
    Application.ScreenUpdating = True ' set back to normal
End Sub
Sub RemoveTrueFalse()
Dim x As Long, a As Long, b As Long
    Application.ScreenUpdating = False ' speed up code for macro
    Application.EnableEvents = False
        For a = 3 To 27 Step 3 'selects columns C F I L O R U
            x = Cells(Rows.Count, a).End(xlUp).Row ' sets last row of source range
        For b = 7 To x    'source range starts at row 7 & goes to bottom
                Range(Cells(7, a), Cells(x, a)).Value = "" 'remove all data from cell
            Next b 'goes to next Row in source sheet
        Next a 'goes to next Col in source sheet
    Application.EnableEvents = True
    Application.ScreenUpdating = True ' set back to normal
End Sub
Sub RemoveColour()
Dim x As Long, a As Long, b As Long
    Application.ScreenUpdating = False ' speed up code for macro
    Application.EnableEvents = False
        For a = 1 To 25 Step 3 'selects columns A D G J M P S
            x = Cells(Rows.Count, a).End(xlUp).Row ' sets last row of source range
        For b = 7 To x    'source range starts at row 7 & goes to bottom
                With Range(Cells(7, a), Cells(x, a)).Interior
                    .Pattern = xlNone
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            Next b 'goes to next Row in source sheet
        Next a 'goes to next Col in source sheet
    Application.EnableEvents = True
    Application.ScreenUpdating = True ' set back to normal
End Sub

Is there anything else that may be causing this?

 

[RoryA]

Don't turn screenupdating and events on and off within the two called procedures, and you are still looping:

Sub RemoveTrueFalse()
Dim x As Long, a As Long, b As Long

        For a = 3 To 27 Step 3 'selects columns C F I L O R U
            x = Cells(Rows.Count, a).End(xlUp).Row ' sets last row of source range
                Range(Cells(7, a), Cells(x, a)).Value = "" 'remove all data from cell
        Next a 'goes to next Col in source sheet
End Sub
Sub RemoveColour()
Dim x As Long, a As Long, b As Long

        For a = 1 To 25 Step 3 'selects columns A D G J M P S
            x = Cells(Rows.Count, a).End(xlUp).Row ' sets last row of source range
                With Range(Cells(7, a), Cells(x, a)).Interior
                    .Pattern = xlNone
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
        Next a 'goes to next Col in source sheet

End Sub

 

[Jonmo1]

You might also turn off Calculation along with Events and ScreenUpdating.

Also, since you're disabling Screenupdating and Events in the first sub, there's no need to do it in the other 2 subs...

Try

Sub RemoveCode()
Dim PrevCalc As Variant
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    PrevCalc = .Calculation
    .Calculation = xlCalculationManual
End With
 
Call RemoveTrueFalse
Call RemoveColour
 
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = PrevCalc
End With
End Sub
 
Sub RemoveTrueFalse()
Dim x As Long, a As Long
 
For a = 3 To 27 Step 3 'selects columns C F I L O R U
    x = Cells(Rows.Count, a).End(xlUp).Row ' sets last row of source range
    Range(Cells(7, a), Cells(x, a)).Value = "" 'remove all data from cell
Next a 'goes to next Col in source sheet
 
End Sub
Sub RemoveColour()
Dim x As Long, a As Long
 
For a = 1 To 25 Step 3 'selects columns A D G J M P S
    x = Cells(Rows.Count, a).End(xlUp).Row ' sets last row of source range
    With Range(Cells(7, a), Cells(x, a)).Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Next a 'goes to next Col in source sheet
End Sub

 

[JackDanIce]

jonmo1,

Would this line:

    Range(Cells(7, a), Cells(x, a)).Value = "" 'remove all data from cell

Be quicker as:

    Range(Cells(7, a), Cells(x, a)).ClearContents 'remove all data from cell

The second line removes the need for evaluation or to set a value per se? I imagine though the noticeable effect is next to negligible...

 

[InaCell]

thanks Glenn, Rory & Jonmo.

Works extremely quick now. Cheers.