Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

Troubleshooting
Research
Professional Opinions
Ask a Question
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

troubleshooting Question

Code efficiency - Help speeding things up. Excel VBA

Avatar of jasocke2
jasocke2Flag for United Kingdom of Great Britain and Northern Ireland asked on
Microsoft ExcelMicrosoft Applications
7 Comments1 Solution555 ViewsLast Modified:
Hi

I have the below code which runs fine however it runs quite slow.
The purpose of it is some reconciliation. I have tweaked it a little however it is still seems quite slow for what it is doing - I think it is the two loops which are taking the longest.

Is there anything else I can do to it to tidy it up and make it faster?

Many thanks,

Sub Recon()
Application.ScreenUpdating = False
Sheets(ActiveSheetName).Activate
    On Error Resume Next
    Sheets("tmp1").Delete
    Sheets("tmp2").Delete
    On Error GoTo 0
    
    Cells.Copy
    Sheets.Add
    ActiveSheet.Paste
    ActiveSheet.Name = "tmp1"
    
    Application.CutCopyMode = False
    
    Selection.rows.Ungroup
    Selection.Columns.Ungroup
    
    Columns("B:J").Delete Shift:=xlToLeft
    rows("2:7").Delete Shift:=xlUp
    rows("3:3").Delete Shift:=xlUp
    

    r = 3
    Do Until Cells(r, 1).Value = ""
    If Cells(r, 1).Value = "Skip" Then
    rows(r).EntireRow.Delete
    Else
    r = r + 1
    End If
    Loop
    
    rows("1:1").Select
    rows("1:1").Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    c = 5
    Do Until Cells(1, c).Value = ""
    If Cells(1, c).Value = "Skip" Then
    Columns(c).EntireColumn.Delete
    Else
    c = c + 1
    End If
    Loop
    
    Columns("C:D").Delete Shift:=xlToLeft
    Columns("A:A").Delete Shift:=xlToLeft
    rows("1:1").Delete Shift:=xlUp
    Cells(1, 1).Value = "Rec"
    
    With ActiveSheet
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With
    Columns(LastCol).Delete Shift:=xlToLeft
    
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Resize.Select

    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Range("A1").Select
    Sheets.Add
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        
    On Error Resume Next
    Sheets("tmp2").Delete
    On Error GoTo 0
    ActiveSheet.Name = "tmp2"
    
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select

    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        
    Sheets("Reconciliation").Select
    rows("120:226").Clear
    Sheets("tmp2").Select
    Selection.Copy
    Sheets("Reconciliation").Select
    Range("A120").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
    
    Range("B120").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 8
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 90
    End With
    
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("tmp1").Delete
    Sheets("tmp2").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").ColumnWidth = 3.43
    
Application.ScreenUpdating = True
End Sub