Very minor change in code had a dramatic impact on the speed. Why?

D

deZine

New Member
Joined
May 6, 2009
Messages
25
I have VBA that changes some formatting on a sheet and creates 30 charts. The code was taking 9-20+ minutes to run until I added some more cell formatting steps. After I added that code it took just a couple seconds but the charts no longer had legends. I added a line of code to each of the charts that had legends to enable them and the code still runs in a couple seconds.
I was shocked by this. Just as a test, I added a line to select a cell just before the section that creates all the charts and it went back to taking a long time. I commented out that new line and it went back to running in a couple seconds.

I still don't understand why the difference is so dramatic. Can anyone help me understand? Thanks in advance for any help with this or any other tips about highly impactful inefficiency in the code.

To see the difference for yourself just comment or uncomment this line about 1/3 of the way through the code--> 'Range("A1").Select 'added because charts...
I would also be happy to share a copy of the sample data if that would be helpful.

Original Code
VBA Code: 
Option Explicit
Sub AddChartSheetToSuperFile()
' Add Charts to Supervisor Workbook
' Written 2022-12-13 by Ian Pirsch
' Last major update: 2022-12-19

'will uncomment these once the code has had more use-testing
    'Application.ScreenUpdating = False
    'Application.DisplayStatusBar = False
    'Application.Calculation = xlCalculationManual
    'Application.EnableEvents = False


'Make a copy of the sheet
    ActiveSheet.Copy , Sheets(Sheets.Count)

'Move MP2 Date Time
    Columns("AP:AP").Cut
    Columns("A:A").Insert Shift:=xlToRight

'Remove rows 1 & 3
    Range("1:1,3:3").Select
    Range("A3").Activate
    Selection.Delete Shift:=xlUp

'Add Shaft Position Error column
    Range("AV1").Formula = "Shaft Position Error"
    Range("AV2").Formula = "=IFS(O2-R2>180,O2-R2-180, O2-R2<-180,O2-R2+180, TRUE,O2-R2)"
    'Autofill to rest of column
        Range("AV2").AutoFill Destination:=Range("AV2:AV" & Range("A" & Rows.Count).End(xlUp).Row)
       
       
    Range("AW1").Formula = "If Overcurrent plot 360"
    Range("AW2").Formula = "=IF(T2=""None"", 0, 360)"
    'Autofill to rest of column
        Range("AW2").AutoFill Destination:=Range("AW2:AW" & Range("A" & Rows.Count).End(xlUp).Row)

    Range("AX1").Formula = "If Bad Motor plot 300"
    Range("AX2").Formula = "=IF(AB2=""None"", 0, 300)"
    'Autofill to rest of column
        Range("AX2").AutoFill Destination:=Range("AX2:AX" & Range("A" & Rows.Count).End(xlUp).Row)

    Range("AY1").Formula = "Power"
    Range("AY2").Formula = "=D2*G2+E2*H2+F2*I2"
    'Autofill to rest of column
        Range("AY2").AutoFill Destination:=Range("AY2:AY" & Range("A" & Rows.Count).End(xlUp).Row)

    Range("AZ1").Formula = "Current (TY)"
    Range("AZ2").Formula = "=SQRT(D2*D2+(D2+2*E2)*(D2+2*E2)/3)"
    'Autofill to rest of column
        Range("AZ2").AutoFill Destination:=Range("AZ2:AZ" & Range("A" & Rows.Count).End(xlUp).Row)


'Format and add autofilter
    Rows("1:1").Select
    Selection.AutoFilter
    Selection.RowHeight = 43.2
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("D2").Select
    ActiveWindow.FreezePanes = True
   
   
   
'Change column widths and cell color  -->after adding this section, the code ran significantly faster
    Columns("D:N").ColumnWidth = 7.67
    Columns("Q:Q").ColumnWidth = 7.67
    Columns("O:O").ColumnWidth = 6.78
    Columns("B:B").ColumnWidth = 3.11
    Columns("B:B").ColumnWidth = 3.78
    Columns("A:A").ColumnWidth = 16.78
    Columns("R:R").ColumnWidth = 7.89
    Columns("S:S").ColumnWidth = 8.11
    Columns("V:V").ColumnWidth = 8.44
    Columns("X:X").ColumnWidth = 6.78
    Columns("Y:Y").ColumnWidth = 7.56
    Columns("Z:Z").ColumnWidth = 8.22
    Columns("AA:AA").ColumnWidth = 8.89
    Columns("AB:AB").ColumnWidth = 8.78
    Columns("AD:AD").ColumnWidth = 9
    Columns("AE:AE").ColumnWidth = 8.67
    Columns("AF:AF").ColumnWidth = 6.78
    Columns("AG:AG").ColumnWidth = 8.22
    Columns("AH:AH").ColumnWidth = 5.78
    Columns("AI:AI").ColumnWidth = 8.67
    Columns("AJ:AJ").ColumnWidth = 8.89
    Columns("AK:AK").ColumnWidth = 10
    Columns("AL:AL").ColumnWidth = 9.67
    Columns("AM:AM").ColumnWidth = 9.11
    Columns("AN:AN").ColumnWidth = 9.33
    Columns("AP:AP").ColumnWidth = 8.89
    Columns("AQ:AQ").ColumnWidth = 8.78
    Columns("AU:AU").ColumnWidth = 9.44
    Columns("AV:AV").ColumnWidth = 7.11
    Columns("AW:AW").ColumnWidth = 10.22
    Columns("AY:AY").ColumnWidth = 8
    Columns("AZ:AZ").ColumnWidth = 8
    Range("AV1:AZ1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
   
   
'Range("A1").Select 'added because charts stopped showing legend after adding code above - discovered chart creation is significantly faster without this line even after adding lines to show legend
   
   
'Create Charts
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,D:F")
    ActiveChart.Axes(xlValue).CrossesAt = -2.5
    ActiveChart.ChartTitle.Text = "Current A B C"
    ActiveChart.SetElement (msoElementLegendBottom)

    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,G:I")
    ActiveChart.ChartTitle.Text = "Voltage A B C"
    ActiveChart.SetElement (msoElementLegendBottom)
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,J:J")

    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,K:K")

    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,L:N")
    ActiveChart.ChartTitle.Text = "Current Offset A B C"
    ActiveChart.SetElement (msoElementLegendBottom)

    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,O:O")
    ActiveChart.Axes(xlValue).MaximumScale = 360
    ActiveChart.Axes(xlValue).MinimumScale = 0

    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,P:P")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,Q:Q")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,R:R")
   

    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,V:V")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,W:W,AD:AD")
    ActiveChart.ChartTitle.Text = "Boot Counts"
    ActiveChart.SetElement (msoElementLegendBottom)
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,X:X")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,Y:Y")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,Z:Z")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AE:AE")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AF:AF,AN:AN")
    ActiveChart.ChartTitle.Text = "Inclination"
    ActiveChart.SetElement (msoElementLegendBottom)
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AG:AG,AO:AO")
    ActiveChart.ChartTitle.Text = "Azimuth"
    ActiveChart.SetElement (msoElementLegendBottom)
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AH:AJ")
    ActiveChart.ChartTitle.Text = "RPM"
    ActiveChart.SetElement (msoElementLegendBottom)
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AK:AK")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AL:AL")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AM:AM")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AP:AP")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AQ:AQ")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AS:AS")

    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AU:AU")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AV:AV")
    ActiveChart.Axes(xlValue).CrossesAt = -180
    ActiveChart.Axes(xlValue).MaximumScale = 180
    ActiveChart.Axes(xlValue).MinimumScale = -180
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AW:AW")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AX:AX")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AY:AY")
   
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,AZ:AZ")
   

    'ActiveChart.Axes(xlValue).Select
    'ActiveChart.Axes(xlValue).CrossesAt = -300
   
   
   
'Format Charts
    Dim ChtObj As ChartObject
    Dim srs As Series
       'Make X-axis Text
        For Each ChtObj In ActiveSheet.ChartObjects
            With ChtObj.Chart
                With .Axes(xlCategory)
                .CategoryType = xlCategoryScale
                End With
            End With
               'Change line weight and transparency
                For Each srs In ChtObj.Chart.SeriesCollection
                    srs.Format.Line.Weight = 1
                    srs.Format.Line.Transparency = 0.5
                Next
        Next
         
'Change size and position of all charts
    Dim iChart As Long
    Dim nCharts As Long
    Dim dTop As Double
    Dim dLeft As Double
    Dim dHeight As Double
    Dim dWidth As Double
    Dim nColumns As Long
    Dim nRows As Long

    dTop = 55      ' top of first row of charts
    dLeft = 212    ' left of first column of charts
    dHeight = 205  ' height of all charts
    dWidth = 432   ' width of all charts
    nColumns = 4   ' number of columns of charts (Comment out 2 lines of Row code about 10 lines below this if you want to use this setting)
    nRows = 3      ' number of rows of charts (Comment out 2 lines of Column code about 7 lines below thisif you want to use this setting)
    nCharts = ActiveSheet.ChartObjects.Count

    For iChart = 1 To nCharts
        With ActiveSheet.ChartObjects(iChart)
            .Height = dHeight
            .Width = dWidth
            '.Top = dTop + Int((iChart - 1) / nColumns) * dHeight
            '.Left = dLeft + ((iChart - 1) Mod nColumns) * dWidth
            .Top = dTop + ((iChart - 1) Mod nRows) * dHeight
            .Left = dLeft + Int((iChart - 1) / nRows) * dWidth
        End With
    Next
   
   
   
'Finishing touches
Range("A1").Select
   
    'Application.ScreenUpdating = True
    'Application.DisplayStatusBar = True
    'Application.Calculation = xlCalculationAutomatic
    'Application.EnableEvents = True
 
End Sub
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Sort by date Sort by votes
Well, you are doing a lot of Selecting, which in most cases isn't necessary.
for example, this
VBA Code: 
Range("1:1,3:3").Select
    Range("A3").Activate
    Selection.Delete Shift:=xlUp

can be reduced to this

VBA Code: 
Range("1:1,3:3").Delete

AND THIS
VBA Code: 
'Add Shaft Position Error column
    Range("AV1").Formula = "Shaft Position Error"
    Range("AV2").Formula = "=IFS(O2-R2>180,O2-R2-180, O2-R2<-180,O2-R2+180, TRUE,O2-R2)"
    'Autofill to rest of column
        Range("AV2").AutoFill Destination:=Range("AV2:AV" & Range("A" & Rows.Count).End(xlUp).Row)

can be

VBA Code: 
Range("AV1").Value = "Shaft Position Error"
    Range("AV2:Av" & Range("A" & Rows.Count).End(xlUp).Row).Formula = "=IFS(O2-R2>180,O2-R2-180, O2-R2<-180,O2-R2+180, TRUE,O2-R2)"

Why are you doing an autofit for ALL columns
VBA Code: 
Cells.EntireColumn.AutoFit

then modifying individual columns with different column widths......double the work ??

That's all I've looked at at this stage, someone else may have further input.
 
Upvote 0
Thanks Michael! I made the changes you recommended and went through and started removing as much of the selecting as I know how to. I am not sure how to create the line charts without this select
VBA Code: 
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("A:A,J:J")

Some more clues about what is slowing the code down --> As I was making the changes I noticed that if I have code selecting any Range of more than one cell just before the charts are created, the code only takes a couple of seconds. If only one cell within my headers or data then it takes over 9 minutes. If I select a cell outside of the headers or data areas, the code runs fast. Still trying to understand why, mostly so I can avoid this type of thing in the future.
Maybe it has something to do with the method I am using to create the charts.
Thanks again for taking the time to look at this.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Worksheet variable from array in ActiveChart source data
Replies
4
Views
484
GWteB
GWteB
E
  • Question Question
Can anyone help me get my VBA code working? I have spent tons of time but can't quite fix it.
Replies
3
Views
3K
profray
P
D
  • Question Question
Problems Encountered When Generating VBA Excel Charts with 15-Minute Interval Data.
Replies
0
Views
356
dilshod_k
D
M
  • Question Question
How to find the last column which is not empty
2
Replies
13
Views
2K
Joe4
Joe4
A
  • Question Question
Help with existing code in Post - VBA to Create Org Chart
Replies
1
Views
2K
mrpotato562
M

Forum statistics

Threads
1,223,885
Messages
6,175,187
Members
452,616
Latest member
intern444

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top