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

L

liferg

Board Regular
Joined
May 21, 2013
Messages
88
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
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Sort by date Sort by votes
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
 
Upvote 0
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
 
Upvote 0
Is there anyone that can assist me with getting this code in to make this run faster?
 
Upvote 0
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
 
Upvote 0
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?
 
Upvote 0
End Sub: is not a valid label.

My code works. Post your modified code if needed.
 
Upvote 0
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
209
Coco1
C
L
  • Question
Variable Rows, Help Speeding Up
Replies
4
Views
318
kevin9999
K
P
  • Question
Help with Vba Code
Replies
3
Views
160
Coyotex3
C
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
332
RoryA
RoryA
L
  • Solved
VBA remove leading zeros
2
Replies
14
Views
974
Joe4
Joe4

Forum statistics

Threads
1,214,986
Messages
6,122,611
Members
449,090
Latest member
vivek chauhan

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top