Why does a simple procedure take so long after conversion from .xls to .xlsm?

[pcc]

Until recently I have been using Excel2002, and I have now upgraded to Excel2021. My old .xls files work fine in compatibility mode. I am experimenting with converting the files to .xlsm format (in-keeping with the later version of Excel), but I have found that in some cases, the code runs much slower after conversion. For example, one procedure in the .xls file takes 3.5 seconds to execute, but after conversion to .xlsm, it takes more than 20 seconds! Can anyone shed any light on why this might be so?

PS I am using a 32-bit version of Office 2021, not 64-bit. Don't know if that's relevant or not.

 

[6StringJazzer]

I can't imagine a scenario where this would happen, but it's hard to tell without seeing the code. Can you share the code? Copy the code from the VBA editor, then paste it into a post. Then select the code and click the VBA button to mark it as code and preserve the formatting.

 

[pcc]

Private Sub CommandButton2_Click()
do_summary
do_graph
topten
maxday
Sheets("Data").Activate
 'Range("A19").Select
 r = 19
 Do Until Cells(r, 9).Value = Year(Date)
 r = r + 1
 Loop
 ActiveWindow.ScrollRow = r
 If Month(Date) > 5 Then ActiveWindow.ScrollRow = r + 4
 ActiveWindow.ScrollColumn = 8
 sapem
 dotarget
 get_av_for_today
 do_adjustment
 ActiveSheet.Protect
End Sub

Sub do_summary()
pmin = Range("prevmin").Value
pmax = Range("prevmax").Value
   ' pmax = 538
ActiveSheet.Unprotect
ActiveSheet.AutoFilterMode = False
 Application.GoTo Reference:="outputgrid"
    Selection.ClearComments
 
    Selection.ClearContents
    [a1].Select
lr = [a1].CurrentRegion.Rows.count
scr_off
sh_add ("Summary")
[a1] = "Year"
[B1] = "Month"
[c1] = "Week"
[d1] = "Output"
iter = 1
drow = 2
Sheets("Data").Activate
r = 2
initrow = 2
prevlread = 0

restart:

initwk = Cells(initrow, 4)
fread = prevlread
Sheets("Summary").Cells(drow, 1) = Cells(initrow, 2)
Sheets("Summary").Cells(drow, 2) = Cells(initrow, 3)
Sheets("Summary").Cells(drow, 3) = Cells(initrow, 4)
Do Until Cells(r, 4) <> initwk
r = r + 1
Loop
lread = Cells(r - 1, 5)



Sheets("Summary").Cells(drow, 4) = lread - prevlread
prevlread = Cells(r - 1, 5)

drow = drow + 1
initrow = r
If Not IsEmpty(Cells(initrow, 5)) Then

GoTo restart
End If
Sheets("Summary").Activate
lr = [a1].CurrentRegion.Rows.count
Rows(lr).Delete
lr = lr - 1
disp_off

lr = [a1].CurrentRegion.Rows.count
[E1] = "Quarter"
For r = 2 To lr
Select Case Cells(r, 2)
Case 1, 2, 3
Cells(r, 5) = "Q1"
Case 4, 5, 6
Cells(r, 5) = "Q2"
Case 7, 8, 9
Cells(r, 5) = "Q3"
Case Else
Cells(r, 5) = "Q4"
End Select
Next r
On Error Resume Next
Sheets("pivot").Delete
Sheets("Chart").Delete
If Err.Number <> 0 Then Err.Clear
On Error GoTo 0

Cells.Select
    Cells.EntireColumn.AutoFit
    Selection.ColumnWidth = 7
    Range("A2").Select
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "Summary!R1C1:R" & lr & "C5").CreatePivotTable TableDestination:="", TableName:= _
        "PivotTable4"
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    ActiveSheet.PivotTables("PivotTable4").SmallGrid = False
    ActiveSheet.PivotTables("PivotTable4").AddFields RowFields:=Array("Year", _
     "Quarter", "Month", "Week")
    ActiveSheet.PivotTables("PivotTable4").PivotFields("Output").Orientation = _
        xlDataField
    Range("D7").Select
     Range("A4").Select
    ActiveSheet.PivotTables("PivotTable4").PivotFields("Year").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable4").PivotSelect "Month[All]", xlLabelOnly
    Range("B4").Select
    ActiveSheet.PivotTables("PivotTable4").PivotFields("Month").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
   
    ActiveSheet.Name = "pivot"
    Range("D22").Select
    Charts.Add
   ' ActiveChart.SetSourceData Source:=Sheets("pivot").Range("a5")
    ActiveChart.Location Where:=xlLocationAsNewSheet
    
    ActiveSheet.Name = "chart"
    ActiveChart.ChartArea.Select
    Application.CommandBars("PivotTable").Visible = False
    Sheets("Data").Activate
  '  Stop
    r = 2
    Do Until IsEmpty(Cells(r, 7))
    r = r + 1
    Loop
    lr = r - 1
    init = 0
   
   r = 2
   Do Until r > lr
    '1573
tyr = Cells(r, 2)
tmon = Cells(r, 3)
'If tmon = 11 Then Stop
Select Case tmon
Case 1: monthtext = "Jan"
Case 2: monthtext = "Feb"
Case 3: monthtext = "Mar"
Case 4: monthtext = "Apr"
Case 5: monthtext = "May"
Case 6: monthtext = "Jun"
Case 7: monthtext = "Jul"
Case 8: monthtext = "Aug"
Case 9: monthtext = "Sep"
Case 10: monthtext = "Oct"
Case 11: monthtext = "Nov"
Case 12: monthtext = "Dec"
Case Else

End Select

Do While Cells(r, 2) = Cells(r + 1, 2) And Cells(r, 3) = Cells(r + 1, 3)
init = init + Cells(r, 7)
r = r + 1
Loop
'If init < 2 Then Stop
'Stop
' add last reading
init = init + Cells(r, 7)
' find the column
c = 1
Do Until Cells(1, c) = tyr
c = c + 1
Loop
'If tyr = 2015 Then Stop
drow = 1
Do Until Cells(drow, 9) = monthtext
drow = drow + 1
Loop
'Stop
Cells(drow, c) = init
'If init > 121 And init < 122 Then Stop

r = r + 1
' now add tothe other block
crow = 21
Do Until Cells(crow, 9) = tyr And Cells(crow, 10) = monthtext
crow = crow + 1
Loop
Cells(crow, 12) = init

init = 0
Loop
Cells(crow, 15).Interior.ColorIndex = 4
newmin = False
newmax = False
For Each cl In Range("K2:AI13")

'If cl.Value <> 0 Then
'If cl.Value < pmin Then
'newmin = True
''Range("prevmin").Value = cl.Value
'End If
'End If

If cl.Value <> 0 Then
If cl.Value > pmax Then
newmax = True
npmax = cl.Value
'Range("prevmax").Value = cl.Value
End If
End If

Next cl
'If newmin = True Then resp = MsgBox("This is an all-time low!", vbInformation)
If newmax = True Then
resp = MsgBox("This is an all-time high!", vbInformation)
mytext = "Previous max was " & pmax
mytext = mytext & vbLf & "New max is " & npmax
MsgBox (mytext)
End If


ActiveSheet.Protect





End Sub

Sub do_graph()
'
' Macro2 Macro
' Macro recorded 20/06/2012 by u59155z
'

'
ActiveSheet.Unprotect
tmon = Month(Date)
tyr = Year(Date)

Select Case tmon
Case 1: monthtext = "Jan"
Case 2: monthtext = "Feb"
Case 3: monthtext = "Mar"
Case 4: monthtext = "Apr"
Case 5: monthtext = "May"
Case 6: monthtext = "Jun"
Case 7: monthtext = "Jul"
Case 8: monthtext = "Aug"
Case 9: monthtext = "Sep"
Case 10: monthtext = "Oct"
Case 11: monthtext = "Nov"
Case 12: monthtext = "Dec"
Case Else

End Select
r = 19
Do Until Cells(r, 9) = tyr And Cells(r, 10) = monthtext
r = r + 1
Loop
lr = r - 1  ' use last completed month

    ActiveSheet.ChartObjects(1).Activate
    ActiveChart.PlotArea.Select
    ActiveChart.ChartArea.Select
    ActiveChart.SetSourceData Source:=Sheets("Data").Range("M21:N" & lr), PlotBy:= _
        xlColumns
    ActiveWindow.Visible = False
    Windows("Solar_panel_output.xls").Activate
    Range("A1").Select
    ActiveSheet.Protect
End Sub

Sub topten()
'
' topten Macro
' Macro recorded 21/05/2020 by Pete
'

'
Sheets("Data").Activate
ActiveSheet.Unprotect
    Application.GoTo Reference:="outputgrid"
    Selection.ClearComments
 Application.ScreenUpdating = False
    sh_add ("temp")
    Sheets("Data").Select
    Range("I20:L323").Select
    Selection.Copy
    Sheets("temp").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("D1").Select
    Range("A1:D293").Sort Key1:=Range("D2"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        
        For r = 2 To 11
        Sheets("temp").Activate
        dr = Cells(r, 1)
        mo = Cells(r, 2)
        pos = r - 1
        Sheets("Data").Activate
        c = 11
        Do Until Cells(1, c) = dr
        c = c + 1
        Loop
    x = 1
    Do Until Cells(x, 9) = mo
    x = x + 1
    Loop
     Cells(x, c).Select
   Selection.AddComment
    Selection.Comment.Visible = False
   
    Selection.Comment.Text Text:=(r - 1) & Chr(10) & ""
    
        Next r
        Sheets("Data").Activate
        ActiveSheet.Protect
        Application.DisplayAlerts = False
        Sheets("temp").Delete
           Application.DisplayAlerts = True
            Range("I6").Select
            Application.ScreenUpdating = True
End Sub


Sub maxday()
ActiveSheet.Unprotect
daymax = Range("prevmin").Value
lr = [a1].CurrentRegion.Rows.count
mtext = vbNullString
For r = 2 To lr
If Cells(r, 7) = daymax Then
mtext = mtext & Cells(r, 1) & vbLf
End If
Next r
Range("prevmin").Select
Selection.ClearComments

   Selection.AddComment
    Selection.Comment.Visible = False
   
    Selection.Comment.Text Text:=mtext
    ActiveSheet.Protect
End Sub

Sub sapem()
Sheets("Data").Activate
ActiveSheet.Unprotect
'ccol = InputBox("Use original column (11) or adjusted column(20)", "Col 20 uses current power", 20)
'If ccol = "" Then End
If UserForm1.OptionButton1.Value = True Then
ccol = 11
Else
ccol = 20
End If
ccol = Val(ccol)
For c = 11 To 35
For r = 2 To 13
If c = 11 And r < 11 Then GoTo skip

tyr = Cells(1, c)
tmon = Cells(r, 9)
'If tyr > Year(Date) Then Exit Sub
'now get theoretical output for this month and year
drow = 20
Do Until Cells(drow, 9) = tyr And Cells(drow, 10) = tmon
drow = drow + 1
Loop
theo = Cells(drow, ccol)



If Cells(r, c) < theo Then
Cells(r, c).Interior.ColorIndex = 40
ElseIf Cells(r, c) >= (theo * 1.1) Then
Cells(r, c).Interior.ColorIndex = 43
Else
Cells(r, c).Interior.ColorIndex = 34
End If
skip:
Next r

Next c
For c = 12 To 35
For r = 2 To 13
If IsEmpty(Cells(r, c)) Then Cells(r, c).Interior.ColorIndex = xlNone
Next r
Next c
ActiveSheet.Protect
End Sub

Sub dotarget()
Sheets("Data").Activate
ActiveSheet.Unprotect
mon = Month(Date)
Select Case mon
Case 1, 3, 5, 7, 8, 10, 12
ndays = 31
Case 4, 6, 9, 11
ndays = 30
Case Else
Select Case Year(data) Mod 4
Case 0
ndays = 29
Case Else
ndays = 28
End Select
End Select
dy = Day(Date)
theo = dy / ndays
Range("target").Value = theo

ActiveSheet.Protect
End Sub

Sub get_av_for_today()
Sheets("Data").Activate
r = 2
Do Until IsEmpty(Cells(r, 7))
r = r + 1
Loop
mo = Month(Date)
dy = Day(Date)
av = 0
daycount = 0
For dr = 2 To r - 1
If Month(Cells(dr, 1)) = mo And Day(Cells(dr, 1)) = dy Then
daycount = daycount + 1
av = av + Cells(dr, 7)
End If
Next dr
resp = MsgBox("Average output in the past for today = " & Format(av / daycount, "0.0") & "kWh", vbInformation)
End Sub

Sub do_adjustment()
Sheets("Data").Activate
ActiveSheet.Unprotect

Sheets("Power").Activate
lr = [a1].CurrentRegion.Rows.count
For r = 2 To lr
Sheets("Power").Activate
pyr = Cells(r, 1)
pmon = Cells(r, 2)
ppower = Cells(r, 3)

Sheets("Data").Activate
drow = 174 ' last row of 100% power
Do Until Cells(drow, 9) = pyr And Cells(drow, 10) = pmon
drow = drow + 1
If Cells(drow, 16) = 0 Then Exit Sub
Loop
Cells(drow, 18) = ppower
Next r
End Sub

Well here it is. I don't think it will be useful as it calls up lots of different procedures, but if you can explain why, I would be very interested.
(NB many of the variables will have been declared as public)

 

[6StringJazzer]

This code is rather hard to read because there is no indentation to show structure. And you are right, the problem could be down in the one of the subs this calls, but it's a mystery as to what's in those.

The first thing to check with performance issues is the loops, which I will try to look at once I figure out where they are.

 

[Alex Blakenburg]

I have no idea why it would be any slower using Excel 2021 but if you are up for an expirement try.
• In your topten sub "comment out" the line
Application.ScreenUpdating = True
• In the controlling CommandButton2_Click "insert" as the first line
Application.ScreenUpdating = False
and make the last line
Application.ScreenUpdating = True

 

[pcc]

Hi Alex. Thanks for your input. I tried your suggestion but it has no impact on the time - still takes around 20 seconds!
I can live with this - I'll just stay with the .xls version for now, but I am intrigued to know why the 'newer' version of Excel seems less efficient than the
older version..

 

[pcc]

I think I have found the reason. You will see from the code above that I have sometimes used "scr_off" and "scr_on". These are custom function that I use as I got bored of typing
"Application.ScreenUpdating = True" all the time.

Public Function scr_off()
Application.ScreenUpdating = False
End Function
Public Function scr_on()
Application.ScreenUpdating = True
End Function

(I made them functions rather than procedures to stop them appearing in the macro listings)
In my workbook, I had (unknowingly) got two instances of these 'functions' (in 2 different modules). I removed one instance of each of them, and the code now runs in 3.5 seconds, just as it did in
the .xls version. I'm a bit surprised that VB didn't object to this (due to possible ambiguity), but in any case, removing the duplicate functions has done the trick. Thanks to all who have taken the time to
look at this post.
(I also use "Disp_off" and "disp_on"for turning displayalerts on and off, and "sh_add" for adding a sheet with a particular name (and deleting it beforehand if it existed)

 

[Alex Blakenburg]

Thanks for letting us know. Glad you found the cause of your issue.
PS: The next step to improve the speed is to eliminate the use of Select and Activate in the code.

 

[pcc]

3.5 seconds is fine, but, yes, I realise it can be sped up more if required. Thanks.