Can I make this macro more efficient or faster?

Viewed 3737

I am brand new to coding. This macro runs slow and I'm hopeful that someone can help me clean it up. Thanks in advance for your help.

I developed the code to update my company's "Call Router" worksheet with new leads purchased from an outside source. The leads come to us in raw format in a worksheet called Fresh Agents Leads. Once the "Fresh Agent Leads" sheet is copied into the "MSS Call Routing Master List" file which houses the "Call Router" Worksheet, the macro reduces the raw data so that the parts we do not use are eliminated. It then re-formats what remains to match the formatting of the Old Call Router Worksheet and merges the two. It then renames the new Master sheet to Call Router.

The code is designed to start inside the workbook that houses the Fresh Agent Leads Sheet. The user is instructed to have both the Fresh Agents Leads File and the MSS Call Routing Master List opened on the desktop before executing the code.

    Sheets("Fresh Agent Leads").Select
    Sheets("Fresh Agent Leads").Copy After:=Workbooks( _
        "MSS Call Routing Master List.xlsx").Sheets(1)
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    Selection.Copy
    Columns("F:F").Select
    ActiveSheet.Paste
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Columns("G:S").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RIGHT(RC[1],4))"
    Range("C1").Select
    Selection.AutoFill Destination:=Range("C1:C1048575")
    Range("C1:C1048575").Select

    Sheets("Call Router").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("Fresh Agent Leads").Select
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    Application.Run "PERSONAL.xlsb!MergeIdenticalWorksheets"
    Columns("C:C").Select
    Selection.NumberFormat = "0000"
    Range("A:A,B:B,F:F").Select
    Range("F1").Activate
    Selection.ColumnWidth = 14
    Columns("E:E").Select
    Selection.ColumnWidth = 25
    Columns("C:C").Select
    Selection.ColumnWidth = 8.29
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("1:1").Select
    Selection.RowHeight = 30
    With Selection
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Columns("D:D").Select
    Selection.EntireColumn.Hidden = True
    Range("E2").Select
    ActiveWindow.FreezePanes = True
    Sheets(Array("Call Router", "Fresh Agent Leads")).Select
    Sheets("Call Router").Activate
    ActiveWindow.SelectedSheets.Delete
    Sheets("Master").Select
    Sheets("Master").Name = "Call Router"
    Range("C23").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveWorkbook.Save
End Sub
3 Answers
Related