Need Help Speeding Up Macro, takes too long to run...

liferg · Dec 26, 2013

Is there something in this macro that I could change that would help speed up the running time?

Rich (BB code):

:Sub LFHOUTFORMATTING()
'
' LFHOUTFORMATTING Macro
'
' Keyboard Shortcut: Ctrl+r
'
    Dim OriginalSheet As Workbook
    Set OriginalSheet = ActiveWorkbook
    Dim lRowData As Long, lRowFormula As Long
    Columns("B:B").Cut
    With Columns("A:A")
        .Insert Shift:=xlToRight
    End With
    With Columns("B:B")
        .Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    End With
    Range("B1") = "VENDOR NAME"
    Range("C1") = "VENDOR#"
    Range("D1") = "PO#"
    Range("E1") = "ATR#"
    Range("F1") = "LOC#"
    Range("G1") = "QTY"
    Range("H1") = "AMOUNT"
    Range("I1") = "REC'D DATE"
    With Columns("E:J")
        .Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    End With
    Range("E1") = "INVOICE#"
    Range("F1") = "AS400 LOC"
    Range("G1") = "INV ERROR"
    Range("H1") = "EDI VENDOR"
    Range("I1") = "PO COST DIFF"
    Range("J1") = "CB RELATED"
    With Columns("P:P")
        .Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    End With
    Range("P1") = "DAYS OLD"
    With Columns("R:R")
        .Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    End With
    Range("R1") = "REQUEST INVOICE"
    Columns("T:T").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("T1") = "DAY RANGE"
    With Range("O:O,S:S")
        .NumberFormat = "m/d/yyyy"
    End With
    With Columns("O:O")
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
            Formula1:="=((TODAY()+(CHOOSE(WEEKDAY((TODAY())),0,1,2,3,4,5,6)))-45)"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1)
            With .Font
                .Bold = True
                .Italic = True
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = -0.499984740745262
            End With
            
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = 5296274
                .TintAndShade = 0
            End With
                .StopIfTrue = False
        End With
    End With
    With Columns("S:S")
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
            Formula1:="=TODAY()+5"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1)
            With .Font
                .Bold = True
                .Italic = True
                .ThemeColor = xlThemeColorAccent2
                .TintAndShade = -0.499984740745262
            End With
    
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent2
                .TintAndShade = 0.399945066682943
            End With
    
            .StopIfTrue = False
        End With
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
            Formula1:="=TODAY()+6", Formula2:="=TODAY()+12"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1)
            With .Font
                .Bold = True
                .Italic = True
                .ThemeColor = xlThemeColorAccent4
                .TintAndShade = -0.499984740745262
            End With
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent4
                .TintAndShade = 0.399945066682943
            End With
    
            .StopIfTrue = False
        End With
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
        Formula1:="=TODAY()+13", Formula2:="=TODAY()+19"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1)
            With .Font
            .Bold = True
            .Italic = True
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = -0.499984740745262
            End With
   
            With .Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorLight2
                .TintAndShade = 0.599963377788629
            End With
    
            .StopIfTrue = False
        End With
    End With
    Columns("T:T").ColumnWidth = 13.57
    With Columns("P:P")
        .ColumnWidth = 10.14
        .FormulaR1C1 = "DUEDATE"
    End With
    Range("T1") = "DAY RANGE"
    Range("P2") = "=TODAY()-RC[-1]"
    With Range("P2")
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
        .AutoFill Destination:=Range("P2:P" & lMaxRows), Type:=xlFillDefault
    End With
    Application.CutCopyMode = False
    With Range("T2")
        .FormulaR1C1 = _
            "=IF(RC[-4]>90,""OVER 90"",IF(RC[-4]>=60, ""60 TO 90"",IF(RC[-4]>=45,""45 TO 59"",IF(RC[-4]>=30, ""30 TO 44"",""UNDER 30""))))"
    End With
    With Range("T2")
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
        .AutoFill Destination:=Range("T2:T" & lMaxRows), Type:=xlFillDefault
    End With
    With Range("B2")
        .CutCopyMode = False
    End With
    Sheets("Sheet1").Select
    Workbooks.Open Filename:= _
        "S:\Merchandise AP New\Vendor Assignment\Vendor Assignments - List for Processors.xlsx", ReadOnly:=True
    OriginalSheet.Activate
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(C[1],'[Vendor Assignments - List for Processors.xlsx]ASSIGNMENTS'!C1:C2,2,FALSE)"
    With Range("B2")
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
        .AutoFill Destination:=Range("B2:B" & lMaxRows), Type:=xlFillDefault
    End With
    Application.CutCopyMode = False
    Range("A1").Select
    Application.CutCopyMode = False
End Sub
Sub ALLHEADER()
'
' ALLHEADER Macro
'
' Keyboard Shortcut: Ctrl+m
'
    Dim InLastRow As Long
    Dim lRowData As Long, lRowFormula As Long
    Sheets("Sheet3").Name = "INV LOC"
    With ActiveSheet.QueryTables.Add(Connection:="ODBC;DSN=AS400_CCOX;", _
        Destination:=Range("A1"))
        .CommandText = Array("SELECT * FROM ADVANCE1.CCOX.ALL_HDR ALL_HDR")
        .Name = "Query from AS400_CCOX"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
    With Columns("C:D")
        .Delete Shift:=xlToLeft
    End With
    With Columns("AN:AN")
        .Cut
    End With
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
    With Columns("E:E")
        .Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    End With
    Range("E1") = "LOCATION"
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("INV LOC").QueryTables(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("INV LOC").QueryTables(1).Sort.SortFields.Add Key:= _
        Range("C2:C103777"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("INV LOC").QueryTables(1).Sort.SortFields.Add Key:= _
        Range("D2:D103777"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("INV LOC").QueryTables(1).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]=R[1]C[-2],RC[-1]&R[1]C[-1],RC[-1])"
    With Range("E2")
        lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
        .AutoFill Destination:=Range("E2:E" & lMaxRows), Type:=xlFillDefault
    End With
    Range("E3").Select
    Sheets.Add After:=Sheets(Sheets.Count)
With ActiveSheet.QueryTables.Add(Connection:="ODBC;DSN=AS400_CCOX;", _
        Destination:=Range("A1"))
        .CommandText = Array("SELECT * FROM ADVANCE1.CCOX.LORRIEH LORRIEH")
        .Name = "Query from AS400_CCOX"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
    Range("A1").Select
    Sheets("Sheet4").Name = "EDI"
    Sheets.Add After:=Sheets(Sheets.Count)
With ActiveSheet.QueryTables.Add(Connection:="ODBC;DSN=AS400_CCOX;", _
        Destination:=Range("A1"))
        .CommandText = Array("SELECT * FROM ADVANCE1.CCOX.LFHOYLE LFHOYLE")
        .Name = "Query from AS400_CCOX"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
    Sheets("Sheet5").Name = "INV ALLOW"
    Sheets.Add After:=Sheets(Sheets.Count)
With ActiveSheet.QueryTables.Add(Connection:="ODBC;DSN=AS400_CCOX;", _
        Destination:=Range("A1"))
        .CommandText = Array("SELECT * FROM ADVANCE1.CCOX.HOYLE HOYLE")
        .Name = "Query from AS400_CCOX"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
    Sheets("Sheet6").Name = "TEST DETAIL"
End Sub
Sub COSTCHARGEBACK()
'
' COSTCHARGEBACK Macro
'
' Keyboard Shortcut: Ctrl+n
'
    Dim InLastRow As Long
    Sheets.Add After:=Sheets(Sheets.Count)
    With ActiveSheet.QueryTables.Add(Connection:="ODBC;DSN=AS400_CCOX;", _
        Destination:=Range("A1"))
        .CommandText = Array("SELECT * FROM ADVANCE1.CCOX.FERGIE FERGIE")
        .Name = "Query from AS400_CCOX"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
    ActiveWorkbook.Worksheets("Sheet7").QueryTables(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet7").QueryTables(1).Sort.SortFields.Add Key:= _
        Range("C2:C12000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet7").QueryTables(1).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Columns("A:A")
        .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(1, 1), TrailingMinusNumbers:=True
    End With
    With Columns("B:B")
        .TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(1, 1), TrailingMinusNumbers:=True
    End With
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet7!R1C1:R12494C23", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="Sheet8!R3C1", TableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion12
    Sheets("Sheet8").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("PO#")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("TCSTDIF1"), "Sum of TCSTDIF1", xlSum
        With ActiveSheet.PivotTables("PivotTable1").PivotFields("IOSUPR")
        ActiveSheet.PivotTables("PivotTable1").PivotFields("IOSUPR").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable1").PivotFields("IOSUPR").LayoutForm = _
        xlTabular
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("ISVNNO")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("ISVNNO").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable1").PivotFields("ISVNNO").LayoutForm = _
        xlTabular
    ActiveSheet.PivotTables("PivotTable1").PivotFields("PO#").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable1").PivotFields("PO#").LayoutForm = _
        xlTabular
        .Orientation = xlRowField
        .Position = 2
    With Range("E4")
        .FormulaR1C1 = _
            "=IF(AND(RC[-3]<>RC[-2],RC[-1]=0),""CHECK PO MANUALLY(BILLED PER PO)"",IF(AND(RC[-3]<>RC[-2],RC[-1]>-100,RC[-1]<100),""CHECK PO MANUALLY(UNDER TOL)"",IF(AND(RC[-3]<>RC[-2],RC[-1]<-100),""CHECK PO MANUALLY(UNDER TOL)"",IF(AND(RC[-3]<>RC[-2],RC[-1]<-100),""CHECK PO MANUALLY(CB@PE)"",IF(AND(RC[-3]<>RC[-2],RC[-1]>100),""CHECK PO MANUALLY(BILLED LESS)"",IF(RC[-1]=0,""BILLED PER PO"",IF(AND(RC[-1]>-100,RC[-1]<100),""UNDER TOL"",IF(RC[-1]<-100,""CB@PE"",IF(RC[-1]>100,""BILLED LESS"","""")))))))))"
    End With
    With Range("E4")
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
        .AutoFill Destination:=Range("E4:E" & lMaxRows), Type:=xlFillDefault
    End With
    Columns("E:E").EntireColumn.AutoFit
    Range("A4").Select
    End With
    Sheets("Sheet8").Name = "PO COST"
    Sheets.Add After:=Sheets(Sheets.Count)
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "ODBC;DSN=AS400_CCOX;", Destination:=Range("$A$1")).QueryTable
        .CommandText = Array( _
        "SELECT LORFERG.CBNUM, LORFERG.CBIVDT, LORFERG.CBCLNM, LORFERG.CBVNNO, LORFERG.CBINV1, LORFERG.CBIDT1, LORFERG.CBPONM, LORFERG.CDSKU, LORFERG.CDMFG, LORFERG.CDRQTY, LORFERG.CDIQTY, LORFERG.CDQDIF, LORF" _
        , _
        "ERG.CDRUNT, LORFERG.CDIUNT, LORFERG.CBSAMT, LORFERG.CBLCQF, LORFERG.CBAMT, LORFERG.CBNUML, LORFERG.CBCOMM" & Chr(13) & "" & Chr(10) & "FROM ADVANCE1.CCOX.LORFERG LORFERG" _
        )
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Table_Query_from_AS400_CCOX7"
        .Refresh BackgroundQuery:=False
    End With
        ActiveSheet.ListObjects("Table_Query_from_AS400_CCOX7").Range.AutoFilter _
        Field:=1, Criteria1:="=*BAR", Operator:=xlAnd
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Delete Shift:=xlUp
    ActiveWorkbook.Worksheets("Sheet9").ListObjects("Table_Query_from_AS400_CCOX7").Sort.SortFields.Clear
    ActiveSheet.ShowAllData
    ActiveSheet.ListObjects("Table_Query_from_AS400_CCOX7").Range.AutoFilter _
        Field:=1, Criteria1:="=*F340", Operator:=xlAnd
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Delete Shift:=xlUp
    Range("Table_Query_from_AS400_CCOX7[[#Headers],[CBNUM]]").AutoFilter
    ActiveSheet.ListObjects("Table_Query_from_AS400_CCOX7").Range.AutoFilter _
        Field:=1, Criteria1:="=*C000", Operator:=xlAnd
    Rows("11:11").Select
    Range(Selection, Selection.End(xlDown)).Delete Shift:=xlUp
    Range("Table_Query_from_AS400_CCOX7[[#Headers],[CBNUM]]").AutoFilter
    ActiveSheet.ListObjects("Table_Query_from_AS400_CCOX7").Range.AutoFilter _
        Field:=1, Criteria1:="=*F800", Operator:=xlAnd
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Delete Shift:=xlUp
    Range("Table_Query_from_AS400_CCOX7[[#Headers],[CBNUM]]").AutoFilter
    ActiveSheet.ListObjects("Table_Query_from_AS400_CCOX7").Range.AutoFilter _
        Field:=1
    ActiveSheet.ListObjects("Table_Query_from_AS400_CCOX7").TableStyle = ""
    ActiveWorkbook.Worksheets("Sheet9").ListObjects("Table_Query_from_AS400_CCOX7" _
        ).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet9").ListObjects("Table_Query_from_AS400_CCOX7" _
        ).Sort.SortFields.Add Key:=Range("Table_Query_from_AS400_CCOX7[CBPONM]"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet9").ListObjects( _
        "Table_Query_from_AS400_CCOX7").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("Table_Query_from_AS400_CCOX7[#All]").RemoveDuplicates _
        Columns:=7, Header:=xlYes
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Table_Query_from_AS400_CCOX7", Version:=xlPivotTableVersion12). _
        CreatePivotTable TableDestination:="Sheet10!R3C1", TableName:="PivotTable2" _
        , DefaultVersion:=xlPivotTableVersion12
    Sheets("Sheet10").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("CBPONM")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("CBNUM")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("PivotTable2").PivotFields("CBNUM").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable2").PivotFields("CBNUM").LayoutForm = _
        xlTabular
    ActiveSheet.PivotTables("PivotTable2").PivotFields("CBPONM").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable2").PivotFields("CBPONM").LayoutForm = _
        xlTabular
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("CBAMT"), "Count of CBAMT", xlCount
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Count of CBAMT")
        .Caption = "Sum of CBAMT"
        .Function = xlSum
        End With
    Sheets("Sheet10").Name = "CHARGEBACK"
      Sheets.Add After:=Sheets(Sheets.Count)
With ActiveSheet.QueryTables.Add(Connection:="ODBC;DSN=AS400_CCOX;", _
        Destination:=Range("A1"))
        .CommandText = Array("SELECT * FROM ADVANCE1.CCOX.LFHDC31 LFHDC31")
        .Name = "Query from AS400_CCOX"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
    With Columns("B:B")
        .TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, FieldInfo _
            :=Array(1, 1), TrailingMinusNumbers:=True
    End With
    Sheets("Sheet11").Name = "MASTER ATR"
End Sub

Sub RNICLEANUP1()
' Keyboard Shortcut: Ctrl+s
Dim MySheet As Worksheet
Dim MyRange As Range
Dim UList As Collection
Dim UListValue As Variant
Dim i As Long
Dim InLastRow As Long
Dim lRowData As Long, lRowFormula As Long
Set MySheet = Sheets(1)
    Sheets("Sheet2").Name = "RNI-WRV"
    Sheets("Sheet1").Select
    With Range("E2")
        .FormulaR1C1 = _
        "=IF(RC[-1]="""",""None"",VLOOKUP(RC[-1],'INV LOC'!C[-3]:C,2,FALSE))"
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
    End With
    With Range("F2")
        .FormulaR1C1 = _
        "=IF(RC[-2]="""",""None"",VLOOKUP(RC[-2],'INV LOC'!C[-4]:C[-1],4,FALSE))"
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
    End With
    With Range("G2")
        .FormulaR1C1 = _
        "=IF(RC[-3]="""",""None"",IF(VLOOKUP(RC[-3],'INV LOC'!C[-5]:C[27],33,FALSE)=""DTL"",VLOOKUP(RC[-3],'TEST DETAIL'!C[-4]:C[-3],2,FALSE),IF(ISERROR(VLOOKUP(RC[-3],'INV LOC'!C[-5]:C[27],33,FALSE)),""None"",VLOOKUP(RC[-3],'INV LOC'!C[-5]:C[27],33,FALSE))))"
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
    End With
    Sheets("EDI").Select
    With Columns("A:A")
        .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(1, 1), TrailingMinusNumbers:=True
    End With
    With Columns("B:B")
        .TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(1, 1), TrailingMinusNumbers:=True
    End With
    With Columns("B:B")
        .Replace What:="2", Replacement:="EDI", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    End With
    Range("A1").Select
    Sheets("Sheet1").Select
    With Range("H2")
        .FormulaR1C1 = "=VLOOKUP(C[-5],EDI!C[-7]:C[-6],2,FALSE)"
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
    End With
    With Range("I2")
        .FormulaR1C1 = "=VLOOKUP(C[-5],'PO COST'!C[-8]:C[-4],5,FALSE)"
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
    End With
    With Range("J2")
        .FormulaR1C1 = "=VLOOKUP(C[-6],CHARGEBACK!C[-9]:C[-7],2,FALSE)"
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
    End With
    With Range("E2:J2")
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
        .AutoFill Destination:=Range("E2:J" & lMaxRows), Type:=xlFillDefault
    End With
    Application.CutCopyMode = False
    Columns("E:E").Replace What:="#N/A", Replacement:="None", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    With Range("F2")
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
        Application.Run "PERSONAL.XLSB!ReplaceNA"
    End With
    With Range("R2")
        .FormulaR1C1 = _
                "=IF(AND(RC[-12]=""TSTHDR"",RC[3]<>""D""),""CHECK TEST BOX"",IF(AND(RC[-12]=""INVHDR"",RC[3]<>""D""),""INV IN LIVE - UNMATCHED"",IF(OR(AND(RC[3]=""N"",RC[-1]=30,RC[-2]>=15,RC[-2]<20),AND(RC[3]=""N"",RC[-1]<>30,RC[-2]>=30,RC[-2]<45),AND(RC[3]=""F"",RC[-1]=30,RC[-2]>=15,RC[-2]<20),AND(RC[3]=""F"",RC[-1]<>30,RC[-2]>=30,RC[-2]<45)),""CONTACT VENDOR FOR INVOICE"",IF(OR(AND(RC[3]=""N"",RC[-1]=30,RC[-2]>=20,RC[-2]<30),AND(RC[3]=""N"",RC[-1]<>30,RC[-2]>=45,RC[-2]<60),AND(RC[3]=""F"",RC[-1]=30,RC[-2]>=15,RC[-2]<20),AND(RC[3]=""F"",RC[-1]<>30,RC[-2]>=30,RC[-2]<45)),""SEND FOLLOW UP EMAIL & COPY CHRISTINA & CHRIS"",IF(OR(AND(RC[3]=""N"",RC[-1]=30,RC[-2]>=30),AND(RC[3]=""N"",RC[-1]<>30,RC[-2]>=60),AND(RC[3]=""F"",RC[-1]=30,RC[-2]>=15,RC[-2]<20),AND(RC[3]=""F"",RC[-1]<>30,RC[-2]>=30,RC[-2]<45)),""CONTACT BUYER FOR ASSISTANCE"","""")))))"
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
        .AutoFill Destination:=Range("R2:R" & lMaxRows), Type:=xlFillDefault
    End With
    With Columns("R:R")
        .FormatConditions.Add Type:=xlTextString, String:= _
        "CONTACT BUYER FOR ASSISTANCE", TextOperator:=xlContains
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1)
            With .Font
                .Bold = True
                .Italic = True
                .ThemeColor = xlThemeColorLight1
                .TintAndShade = 0
            End With
            .StopIfTrue = False
        End With
    End With
    Application.CutCopyMode = False
    '// Copy everything
    ActiveSheet.Cells.Copy
    '// Paste special with values
    ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
        With ActiveWorkbook.Worksheets("Sheet1").QueryTables(1).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Columns("F:F")
        .Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    End With
    With Range("F1")
        .FormulaR1C1 = "INV DATE"
    End With
    With Columns("M:M")
        .Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    End With
    With Range("M1")
        .FormulaR1C1 = "MASTER ATR#"
    End With
    With Range("F2")
        .FormulaR1C1 = "=VLOOKUP(C[-1],'INV LOC'!C[-3]:C,4,FALSE)"
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
        .AutoFill Destination:=Range("F2:F" & lMaxRows), Type:=xlFillDefault
    End With
    With Range("F2")
        .Copy
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        .TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, FieldInfo _
            :=Array(1, 5), TrailingMinusNumbers:=True
            .NumberFormat = "m/d/yyyy"
    End With
    Columns("F:F").ColumnWidth = 10.57
    With Range("M2")
        .FormulaR1C1 = "=VLOOKUP(C[-9],'MASTER ATR'!C[-11]:C[-10],2,FALSE)"
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
        .AutoFill Destination:=Range("M2:M" & lMaxRows), Type:=xlFillDefault
    End With
    With Columns("D:D")
        .TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, FieldInfo _
            :=Array(1, 1), TrailingMinusNumbers:=True
        lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
    End With
    Application.CutCopyMode = False
    '// Copy everything
    ActiveSheet.Cells.Copy
    '// Paste special with values
    ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
        With ActiveWorkbook.Worksheets("Sheet1").QueryTables(1).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Sheet1").Select
    With Range("A1")
        .AutoFilter
        .Range("$A$1:$Y$5000").AutoFilter Field:=6, Criteria1:= _
            "=tsthdr*", Operator:=xlAnd
    End With
    With Rows("1:1")
        Range(Selection, Selection.End(xlDown)).Select
        .Copy
    End With
    Sheets("SHEET12").Select
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Sheets("Sheet12").Name = "CRYSTAL-TSTHDR"
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Sheet1").Select
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$Y$15000").AutoFilter Field:=4, Criteria1:="=WV*", _
        Operator:=xlAnd
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Copy
    Sheets("RNI-WRV").Activate
    With Range("A1")
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End With
    Columns("A:A").EntireColumn.AutoFit
    Application.CutCopyMode = False
    Application.DisplayAlerts = False
    With Range("A1")
        .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(14), _
            Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    End With
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    Application.DisplayAlerts = True
    Columns("N:N").EntireColumn.AutoFit
    MySheet.Select
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$Y$6000").AutoFilter Field:=2, Criteria1:="#N/A"
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Sheet13").Select
    ActiveSheet.Paste
    Range("A1").Select
    Columns("A:A").EntireColumn.AutoFit
    Range("A1").Select
    Sheets("Sheet13").Name = "UNASSIGNED VENDORS"
    MySheet.Select
    With MySheet.AutoFilter.Range
    .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$Y$5000").AutoFilter Field:=1, Criteria1:="=*HSBC*" _
        , Operator:=xlAnd
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter
    Range("A1").Select
    Selection.AutoFilter
    Selection.AutoFilter
If MySheet.AutoFilterMode = False Then
    Exit Sub
End If
Set MyRange = Range(MySheet.AutoFilter.Range.Columns(1).Address)
Set UList = New Collection
On Error Resume Next
For i = 2 To MyRange.Rows.Count
UList.Add MyRange.Cells(i, 1), CStr(MyRange.Cells(i, 1))
Next i
On Error GoTo 0
For Each UListValue In UList
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets(CStr(UListValue)).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    MyRange.AutoFilter Field:=1, Criteria1:=UListValue
    MySheet.AutoFilter.Range.Copy
    Worksheets.Add.Paste
    ActiveSheet.Name = Left(UListValue, 30)
    Cells.EntireColumn.AutoFit
Next UListValue
MySheet.AutoFilter.ShowAllData
MySheet.Select
End Sub
Sub RNICLEANUP2()
' Keyboard Shortcut: Ctrl+w

    MyName = "Weekly RNI & DC OPEN RECEIPTS Report"
    DirPath = "S:\Merchandise AP New\Weekly RNI Reports\2013"
    DateStr = Format(Date, "mm-dd-yy")
    Dim MySheet As Worksheet
    Dim MyRange As Range
    Dim UList As Collection
    Dim UListValue As Variant
    Dim i As Long
    Dim InLastRow As Long
    Dim lRowData As Long, lRowFormula As Long
Set MySheet = Sheets(1)

Sheets("C JACOBI").Select
    ActiveWorkbook.Worksheets("C JACOBI").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("C JACOBI").Sort.SortFields.Add Key:=Range( _
        "R2:R5000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("C JACOBI").Sort
        .SetRange Range("A1:Y5000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(16), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    With Columns("P:P")
        .Style = "Comma"
    End With
    Range("A1").Select
Sheets("G ANDERSON").Select
    ActiveWorkbook.Worksheets("G ANDERSON").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("G ANDERSON").Sort.SortFields.Add Key:=Range( _
        "P2:P5000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("G ANDERSON").Sort
        .SetRange Range("A1:Y5000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(16), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    With Columns("P:P")
        .Style = "Comma"
    End With
    Range("A1").Select
Sheets("H PINION").Select
    ActiveWorkbook.Worksheets("H PINION").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("H PINION").Sort.SortFields.Add Key:=Range( _
        "R2:R5000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("H PINION").Sort
        .SetRange Range("A1:Y5000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(16), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    Columns("P:P").Select
    Selection.Style = "Comma"
    Range("A1").Select
Sheets("J DOZIER").Select
    ActiveWorkbook.Worksheets("J DOZIER").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("J DOZIER").Sort.SortFields.Add Key:=Range( _
        "R2:R5000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("J DOZIER").Sort
        .SetRange Range("A1:Y5000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(16), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    With Columns("P:P")
        .Style = "Comma"
    End With
    Range("A1").Select
Sheets("J HURD").Select
    ActiveWorkbook.Worksheets("J HURD").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("J HURD").Sort.SortFields.Add Key:=Range( _
        "R2:R5000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("J HURD").Sort
        .SetRange Range("A1:Y5000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(16), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    With Columns("P:P")
        .Style = "Comma"
    End With
    Range("A1").Select
Sheets("L FERGUSON HOYLE").Select
    ActiveWorkbook.Worksheets("L FERGUSON HOYLE").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("L FERGUSON HOYLE").Sort.SortFields.Add Key:=Range( _
        "R2:R5000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("L FERGUSON HOYLE").Sort
        .SetRange Range("A1:Y5000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(16), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    Columns("P:P").Select
    Selection.Style = "Comma"
    Range("A1").Select
Sheets("T SISSON").Select
    ActiveWorkbook.Worksheets("T SISSON").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("T SISSON").Sort.SortFields.Add Key:=Range( _
        "R2:R5000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("T SISSON").Sort
        .SetRange Range("A1:Y5000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(16), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    With Columns("P:P")
        .Style = "Comma"
    End With
    Range("A1").Select
    ActiveWindow.SmallScroll ToRight:=4
    MySheet.Select
    Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Range("A1").Select
    Sheets("Sheet1").Select
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AA$4000").AutoFilter Field:=25, Criteria1:="O"
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Sheet23").Select
    Application.CutCopyMode = False
    Sheets("Sheet23").Move Before:=Sheets(1)
    Sheets("Sheet1").Select
    Selection.Copy
    Sheets("Sheet23").Select
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Sheet23").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet23").Sort.SortFields.Add Key:=Range("F2:F1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet23").Sort
        .SetRange Range("A1:AA1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Columns("F:F")
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End Wtih
    Range("A1").Select
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet23!R1C1:R685C27", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Sheet24!R3C1", TableName:="PivotTable2", DefaultVersion _
        :=xlPivotTableVersion14
    Sheets("Sheet24").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("REMITTERM")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("VENDOR#")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("VENDOR NAME")
        .Orientation = xlRowField
        .Position = 3
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("PO#")
        .Orientation = xlRowField
        .Position = 4
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("AMOUNT"), "Sum of AMOUNT", xlSum
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("LOC#")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("DAY RANGE")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable2").PivotFields("REMITTERM").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable2").PivotFields("REMITTERM").LayoutForm = _
        xlTabular
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Sum of AMOUNT")
        .NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
    End With
    Range("B5").Select
    ActiveSheet.PivotTables("PivotTable2").PivotFields("VENDOR#").ShowDetail = _
        False
    ActiveSheet.PivotTables("PivotTable2").PivotFields("DAY RANGE").AutoSort _
        xlAscending, "DAY RANGE"
    ActiveSheet.PivotTables("PivotTable2").PivotSelect "LOC#", xlButton, True
    Range("A2").Select
    Sheets("Sheet24").Name = "DC OPEN RECEIPTS"
    Sheets("Sheet23").Name = "OPEN RECEIPTS DATA"
    Sheets("DC OPEN RECEIPTS").Select
ActiveWorkbook.SaveAs Filename:=DirPath & DateStr & MyName
End Sub
Sub WEEKLYRNIREPORT()
'
' WEEKLYRNIREPORT Macro
'
' Keyboard Shortcut: Ctrl+e
'
    Application.Run "PERSONAL.XLSB!GetLFHOUT"
    Application.Run "PERSONAL.XLSB!LFHOUTFORMATTING"
    Application.Run "PERSONAL.XLSB!ALLHEADER"
    Application.Run "PERSONAL.XLSB!COSTCHARGEBACK"
    Application.Run "PERSONAL.XLSB!RNICLEANUP1"
    Application.Run "PERSONAL.XLSB!RNICLEANUP2"
End Sub

Kenneth Hobson · Dec 26, 2013

Add a call to SpeedOn but prior to that line, add an "On Error Goto SomeLabel" where you call SpeedOff after the label.

Code:

'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
Public glb_origCalculationMode As Integer

Sub SpeedOn(Optional StatusBarMsg As String = "Running macro...")
  glb_origCalculationMode = Application.Calculation
  With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    .Cursor = xlWait
    .StatusBar = StatusBarMsg
    .EnableCancelKey = xlErrorHandler
  End With
End Sub

Sub SpeedOff()
  With Application
    .Calculation = glb_origCalculationMode
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    .CalculateBeforeSave = True
    .Cursor = xlDefault
    .StatusBar = False
    .EnableCancelKey = xlInterrupt
  End With
End Sub

liferg · Dec 26, 2013

Hi Kenneth,

I'm no expert with macros. I just basically record what I want done and then try to tweek what I can. With that being said, I have no idea to do what you have instructed. I am not sure where this coding would need to go and where to put "SomeLabel". Can you please elaborate for me?

Thanks,

Lorrie

liferg · Dec 26, 2013

Is there anyone that can assist me with getting this code in to make this run faster?

Kenneth Hobson · Dec 26, 2013

Example of how I explained to use my subs:

Code:

Sub YourSubNameHere()
    On Error GoTo EndSub
    SpeedOn
     
' your code here
     
EndSub:
    SpeedOff
End Sub

Yes, I suspect that you could go beyond the macro recorder and make your code more efficient. Beyond Excel's recorder

liferg · Dec 26, 2013

I am getting a compile error: Label not defined message. I know I'm getting this because the End Sub is not there, but if I put the End Sub: SpeedOff, then the macro is not going on to the next macro. How do I get the macros to go from one to the other so that they all run and not stop when defining the label?

Kenneth Hobson · Dec 26, 2013

End Sub: is not a valid label.

My code works. Post your modified code if needed.

slx · Dec 26, 2013

That is one seriously long macro, i recommend breaking it down into smaller pieces. Especially since i see you make query connections to an external database. Your problem might be steming from the connections. If that is the case you can't improve the code, that is dependent on your connection speed and the database's capability of providing the data. But you won't be able to figure out unless you break into smaller pieces and run each piece individually. This way you can actually time each segment to know which part is under performing. If you are hanging at a specific query then you know its not the code and its the database it is accessing.

Need Help Speeding Up Macro, takes too long to run...

liferg

Board Regular

Excel Facts

Kenneth Hobson

Well-known Member

liferg

Board Regular

liferg

Board Regular

Kenneth Hobson

Well-known Member

liferg

Board Regular

Kenneth Hobson

Well-known Member

slx

New Member

Similar threads

Forum statistics

Share this page

Need Help Speeding Up Macro, takes too long to run...

Board Regular

Excel Facts

Well-known Member

Board Regular

Board Regular

Well-known Member

Board Regular

Well-known Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock