How can i get this macro to run faster?

[Miya]

Hello, the following macro takes 1min and 20 seconds to run, what can i do to make this run faster?

Sub Sort_Noms()
    Dim i, LR, LR2 As Long
    Dim original, short
    
With Application
        .EnableEvents = False
        .Calculation = xlCalculationManual
        If .ScreenUpdating = True Then .ScreenUpdating = False
    End With
    
    With Sheets("Rec")
        .Range("A5").Resize(, 12).Value = [{"Tracker","Group","Value Date","Statement Date","Item Type","Amount","Source Code","Age","Reference 1","Reference 2","Reference 3","Reference 4"}]
         LR2 = .Cells(Rows.Count, 1).End(xlUp).Row
        If LR2 >= 6 Then
            .Range("A6:K" & LR2).Clear
        End If
    End With
    With Sheets("RAW_DATA")
        LR = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("A5:A" & LR).Copy Sheets("Rec").Range("B5")
        .Range("D5:D" & LR).Copy Sheets("Rec").Range("C5")
        .Range("E5:E" & LR).Copy Sheets("Rec").Range("D5")
        .Range("C5:C" & LR).Copy Sheets("Rec").Range("E5")
        .Range("G5:G" & LR).Copy Sheets("Rec").Range("F5")
        .Range("I5:I" & LR).Copy Sheets("Rec").Range("G5")
        .Range("K5:K" & LR).Copy Sheets("Rec").Range("I5")
        .Range("L5:L" & LR).Copy Sheets("Rec").Range("J5")
        .Range("M5:M" & LR).Copy Sheets("Rec").Range("K5")
        .Range("N5:N" & LR).Copy Sheets("Rec").Range("L5")
    End With
    With Sheets("Rec")
        original = Array("Our Cash Credit", "Our Cash Debit", _
                "Their Cash Credit", "Their Cash Debit")
        short = Array("LCR", "LDR", "SCR", "SDR")
        With .Range("E6", Range("E" & Rows.Count).End(xlUp))
        For i = 0 To UBound(original)
            .Replace What:=original(i), replacement:=short(i)
        Next i
        .Offset(, 1).Value = Evaluate("IF(Right(" & .Address & ",2)=""DR"",-" _
                & .Offset(, 1).Address & "," & .Offset(, 1).Address & ")")
        End With
    
    With .Range("H6:H" & LR)
        .Formula = "=ABS(C6-CoverSheet!$E$27)"
        .Copy
        .PasteSpecial xlPasteValues
        .NumberFormat = "General"
    End With
    With .Range("F6:F" & LR)
        .NumberFormat = "#,##0.00;[Red]#,##0.00"
    End With
    With .Range("B6:L8000")
        With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13434828
        End With
    With .Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
          .ColorIndex = 2
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 2
    End With
End With
With .Range("I6:L" & LR)
        .ColumnWidth = 25
        .RowHeight = 12.75
        .WrapText = True
        .Cells.HorizontalAlignment = xlCenter
End With
With .Range("A5:L5")
        With .Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlMedium
        End With
        With .Font
            .Bold = True
        End With
    End With
    
.Range("A5:L" & LR).HorizontalAlignment = xlCenter
LR = .Range("B" & Rows.Count).End(xlUp).Row
For i = LR To 6 Step -1
    Select Case .Range("B" & i).Value
        Case "NOMS"
        'do nothing
        Case Else: .Rows(i).Delete
    End Select
Next i
End With
With Range("Data")
.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("Criteria"), Unique:=False
.Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
 If Sheets("Rec").FilterMode Then
    Sheets("Rec").ShowAllData
  End If
  
With Application
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .CutCopyMode = True
    If .ScreenUpdating = False Then .ScreenUpdating = True
  End With
End Sub

 

[Miya]

*bump*

 

[Kenneth Hobson]

I don't see what would help. You are already using the standard speed tricks. Have you tried rebooting? How does it perform on other computers?

If you post a sample xls with the data and the macro, we could better troubleshoot. You can post to free shared sites like 4shared.com.

 

[mikerickson]

If you use worksheet variables

Dim shtRec as Worksheet
Dim shtRawData as worksheet
Set shtRec = Sheets("Rec")
set sheRawData = Sheets("RAW_DATA")

and replace all references with the variable, the property Sheets(sheetName) has to be calculated fewer times.

 

[Fazza]

Hi Miya.

The first lines of the code dim only one of the variables. "dim a,b,c as long" dims only c as long and a & b as variant. Likely you want "dim i as long, LR as long, LR2 as long". Beyond that it is difficult to say.

It would be better IMO if you explained in words what the code does and gave a sample of some inputs and corresponding outputs. It would be much easier then for others to understand; and you can expect a better response. There are usually many ways to achieve a required result and someone might offer an alternate method that is inherently quicker.

From a 20 second glance at the code, and I may be wrong, it does seem that whatever it is doing should be able to be done in a second or two. Can you explain in words, with sample data, what is required?

Regards, Fazza