Help..macro running deadly slow - Subtotal and rows delete

[dwilson38550m]

Hi, I wonder if anyone could suggest anything - my macro runs desperately slow when it hits the operation to remove subtotal, delete entire rows with a number 1 (paste special values number not a formula) in a specific column and subtotal the data. I have approx 1500 rows but it seems to go very slowly performing these operations. I have cleaned up the data as much as possible....I have found a workaround by doing each step manually but would like to run as part of the macro automation.
Thanks in advance.
David

 

[MARK858]

It might help if you posted the macro in code tags please (copy your code, paste it in the thread, select all the code and click the # icon).

 

[alansidman]

Suggest you post your code for analysis and see if it can be streamlined. Also, explain in detail what you expect the code to do. An example is always helpful, too.

 

[dwilson38550m]

OK no problem..will do.

 

[dwilson38550m]

HI,

The macro I am using for subtotalling on DATAWORKINGS tab :
----------------------------------------------------------------------------

Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    ActiveWorkbook.Worksheets("DataWorkings").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DataWorkings").Sort.SortFields.Add Key:=Range( _
        "A2:A600"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("DataWorkings").Sort.SortFields.Add Key:=Range( _
        "C2:C600"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("DataWorkings").Sort.SortFields.Add Key:=Range( _
        "M2:M600"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DataWorkings").Sort
        .SetRange Range("A2:U600")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
        
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    ActiveWindow.ScrollRow = 1
    Selection.subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    Sheets("Instructions").Select
    Range("A1").Select

The macro I use for REMOVING SUBTOTALS on DATAWORKINGS is :
--------------------------------------------------------------------------------------------

Sub removesubtot()
'
' removesubtot Macro
'

'
    Sheets("DataWorkings").Select
    ActiveSheet.Outline.ShowLevels RowLevels:=3
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.RemoveSubtotal
    Range("A2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("Instructions").Select
    Range("A1").Select
End Sub

------------------------------------------------------------------------------------------------

The macro I use to remove/delete entire rows where there is a "1" in column S :

---------------------------------------

Sub delete()
'
' delete Macro
'

Sheets("DataWorkings").Select
Range("A2").Select

 Dim LR As Long
 Application.ScreenUpdating = False

 For LR = Range("S" & Rows.Count).End(xlUp).Row To 1 Step -1
 If Range("S" & LR).Value = 1 Then
Rows(LR).EntireRow.delete
 End If
 Next LR
 Application.ScreenUpdating = True

 
End Sub

---------------------------------------------------------------

 

[Derek Brown]

In addition to "ScreenUpdating", you need to set calculation mode to "Manual" and turn off "EnableEvents" (remembering to turn them back on at the end of the process).
Recalculation could be slow if you have volatile functions:
http://www.decisionmodels.com/calcsecrets.htm

http://www.decisionmodels.com/calcsecretsi.htm

 

[MARK858]

Not by a computer so can't post code but you need to lose the Selects and try Autofilter for the Delete code.