how can I speed up a specific macro?

[cjcass]

Hi,
I have the code below which works fine but am looking to see if anyone knows of a way to speed it up - it currently takes around 12 secs to run.
You will notice that the ranges all have the same row numbers.
Many thanks.

Application.ScreenUpdating = False
For Each c In Range("K23:K56,AC23:AC56,AU23:AU56,BM23:BM56,CE23:CE56,CW23:CW56,EG23:EG56,EY23:EY56,FQ23:FQ56,GI23:GI56,HA23:HA56,HS23:HS56,IK23:IK56,JC23:JC56,JV23:JV56,KM23:KM56,LE23:LE56,LW23:LW56,MO23:MO56")
    Select Case Len(c)
        Case 80 To 130
            c.Font.Size = 10
        Case 131 To 150
            c.Font.Size = 9
        Case Is > 150
            c.Font.Size = 8
        Case Else
            c.Font.Size = 11
    End Select
Next
Application.ScreenUpdating = True

 

[mrhstn]

I can't see any real reason that should take so long to run, is there anything else acting on the worksheet/workbook?

In any event with so few conditions you could just opt for if/elseif instead of switching the length of the cell value

Dim c As Range
Dim myRng As Range
Set myRng = Range("K23:K56,AC23:AC56,AU23:AU56,BM23:BM56,CE23:CE56,CW23:CW56,EG23:EG56,EY23:EY56,FQ23:FQ56,GI23:GI56,HA23:HA56,HS23:HS56,IK23:IK56,JC23:JC56,JV23:JV56,KM23:KM56,LE23:LE56,LW23:LW56,MO23:MO56")
Application.ScreenUpdating = False
For Each c In myRng
    If Len(c.Value) > 150 Then
        c.Font.Size = 8
    ElseIf Len(c.Value) > 130 Then
        c.Font.Size = 9
    ElseIf Len(c.Value) > 80 Then
        c.Font.Size = 10
    Else
        c.Font.Size = 11
    End If
Next
Application.ScreenUpdating = True

 

[cjcass]

Hi,
Thanks for your response. Have ran your macro and it takes 11 secs.
Each cell in the ranges has a simple formula in it reading text from another wksheet but that's all.
Rgds,

 

[mrhstn]

How about trying to turn off calculations while it's running?

Application.Calculation = xlCalculationManual

'...Your code goes in here

Application.Calculation = xlCalculationAutomatic

 

[cjcass]

ok, tried that but no change.

 

[Peter_SSs]

Each cell in the ranges has a simple formula in it reading text from another wksheet but that's all.

I set up a two sheets to simulate that with the formulas drawing in text of varying lengths (60-200 characters). The code from your opening post took just over 0.1 seconds to run. Seems to me also that something else must be going on.

I would suggest setting up a fresh workbook with some dummy data and testing the code on that.

 

[GTO]

Greetings cjcass,

I ran the snippet you posted against cells with various length strings and it completed in a couple of blinks of the eyes (fast, I just didn't formally time it).

I do not see where the snippet should cause any calculation or anything that would fire any worksheet event that I can think of. Is what you posted the entirety of the procedure, or might you want to post the entire Sub/Function?

Mark

 

[cjcass]

Hi,
Have had a look at the wksheet and each cell in every range in the macro has 5 dependent cells in the wksheet, each with a formula reading from the cell being changed by the macro.
I tried this but no change...

Sheet18.EnableCalculation = False
Code
Sheet18.EnableCalculation = True

 

[cjcass]

oh and yes, I posted the entire procedure

 

[GTO]

oh and yes, I posted the entire procedure

Thank you

Hi,
Have had a look at the wksheet and each cell in every range in the macro has 5 dependent cells in the wksheet, each with a formula reading from the cell being changed by the macro.
I tried this but no change...

Sheet18.EnableCalculation = False
Code
Sheet18.EnableCalculation = True

If I am reading that correctly, you are saying that any/all dependent cells are on the same sheet (CodeName 'Sheet18') that we are changing the font size on.

Neither the calculate or change events should be getting called as far as I can see. Regardless, I would try Application.Calculation instead, just because its an easy test.

Presuming no notable change, in a new/blank/throw-away workbook, try setting up for a test, something like:

Sub setup()
Dim c As Range
  
Randomize
  
  For Each c In Range("K23:K56,AC23:AC56,AU23:AU56,BM23:BM56,CE23:CE56,CW23:CW56,EG23:EG56,EY23:EY56,FQ23:FQ56,GI23:GI56,HA23:HA56,HS23:HS56,IK23:IK56,JC23:JC56,JV23:JV56,KM23:KM56,LE23:LE56,LW23:LW56,MO23:MO56")
    c.Value = String$(Int((180 - 80 + 1) * Rnd + 80), "c")
  Next
  
  
  
End Sub

Then as Peter suggests, run your code against the temp/test wb.

Mark