Macro generates 11 pivot tables on 3 sheets ...

megnin

megnin

Active Member
Joined
Feb 27, 2002
Messages
340
and saves as a new workbook with the date in the filename.

Would some kind soul take a look at this macro and see if there is anywhere that it could be made more effecient or if I'm doing anything really dumb. :oops:

I think pivot tables 2 through 5 are set up to use the same data as pivot table 1 thus keeping the file size to a minimum.

Sheet 2 has the next 3 pivot tables. I'm not sure if I'm copying those correctly to use the same data as the first PT. (All should use the same data as PT #1.)

Anyway, any tips would be greatly appreciated. I'm hopeing to maybe learn new techniques to do things.

(What's the size limit for code snipetts?)
Code: 
Dim dtHigh As Date
Dim dtLow As Date

Dim i As Integer
Dim myStr
Dim shtName
Dim fName
Dim Msg, Style, Title, Response, MyString
Sub ReportsNewFrmt()
'20030716
'modified 6/30/03 by David
Title = "This may take a while..."

  Msg = "                The >50000 formula will take several minutes to generate. " & Chr(13) & Chr(10) & Chr(10) & _
        "                     It takes about 8 minutes on a Pentium 4 1.8Ghz PC. " & Chr(13) & Chr(10) & Chr(10) & _
        "                    When that's done, the pivots will begin to generate." & Chr(13) & Chr(10) & Chr(10) & _
        "                 Several Sheets will be added and pivot tables built in them." & Chr(13) & Chr(10) & Chr(10) & _
        "Then the sheets will be moved to a new Workbook and saved to the current folder." & Chr(13) & Chr(10) & Chr(10) & _
        "                          A message box will indicate when all is done."


Style = vbOKCancel + vbInformation
Response = MsgBox(Msg, Style, Title)
If Response = vbCancel Then            'End If is at the very end of this procedure...
    Title = "Action Canceled"
    Msg = "Reports Generation Canceled."
    Style = vbOKOnly + vbExclamation
    Response = MsgBox(Msg, Style, Title)
End
Else
    Title = "Go get a cup of coffee!"
    Msg = "You may even have time for breakfast ;-)"
    Style = vbOKOnly + vbInformation
    Response = MsgBox(Msg, Style, Title)


If Weekday(Date) = 2 Then
    myStr = Format(Date - 2, "mmdd") ' Used to put COB date in this format "COB 0630". On Mondays COB date will be previous Friday.
Else
    myStr = Format(Date - 1, "mmdd") ' For non-Mondays
End If
    
    shtName = "Voice Holds COB " & myStr

'Begin Order_CNT_Flag creation ---------------------------------------------
    
    Sheets("Open Orders RSD").Select
    Range("A1").Select
    'Sort by  "parent_sales_order_id" and "Ord Drop Dead Date"  "E2" and "Aa2"  before Order_CNT_Flag is inserted.
    ActiveSheet.UsedRange.Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:= _
        Range("AA2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
    
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Order_CNT_Flag"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=IF(AND(RC[1]=R[-1]C[1], RC[23]=R[-1]C[23]),0,1)"  '"parent_sales_order_id" plus 23 columns is "Ord Drop Dead Date" (after column is inserted at F:F)
'    ActiveCell.FormulaR1C1 = "=IF(AND(RC[1]=R[-1]C[1], RC[34]=R[-1]C[34]),0,1)"  '"parent_sales_order_id" plus 34 columns is "Ord Drop Dead Date" (after column is inserted at F:F)
    Selection.Copy
    
'    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select  '<- No no no no, this copied it to the whole sheet
'    Range(Selection, Range("F65536").End(xlUp)).Row.Select
    endrow = Range("A65536").End(xlUp).Row
    Range("E2:E" & endrow).Select
    
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Selection.End(xlUp).Select
    Application.CutCopyMode = False

'End Order_CNT_Flag creation ---------------------------------------------


usrows = ActiveSheet.UsedRange.Rows.Count
uscols = ActiveSheet.UsedRange.Columns.Count

    Sheets("Open Orders RSD").Select
    Range("DP1").Select
    ActiveCell.FormulaR1C1 = ">50000"
    Range("DP2").Select
    
    ActiveCell.FormulaR1C1 = _
       "=SUMIF(R2C13:R" & usrows & "C13,RC[-107],R2C68:R" & usrows & "C68)>50000"  'SUMIF (Parent_POID, Parent_POID, Rev_Amount)>50000  (Range, Criteria, Sum Range)
'    ActiveCell.FormulaR1C1 = _
       "=SUMIF(R2C13:R" & usrows & "C13,RC[-103],R2C68:R" & usrows & "C68)>50000"  'SUMIF (Parent_POID, Rev_Amount)>50000
'    ActiveCell.FormulaR1C1 = _
       "=SUMIF(R2C15:R" & usrows & "C15,RC[-71],R2C29:R" & usrows & "C29)>50000"  'SUMIF Parent_POID
    Selection.Copy
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Selection.End(xlUp).Select
    Application.CutCopyMode = False

Worksheets.Add
ActiveSheet.Name = shtName
'------------------------------------------------------------------------------------------------Pivot #1

ActiveSheet.PivotTableWizard SourceType:=xlDatabase, _
        SourceData:=Sheets("Open Orders RSD").UsedRange, _
        TableDestination:=ActiveCell, TableName:= _
        "Value", SaveData:=True
    
With ActiveSheet.PivotTables("Value")
    .AddFields RowFields:=Array("Country_Code", "TEAMLEAD", "Channelgroup", "Status"), PageFields:=Array("Ord_LOB", "RMA_Flag")
    .PivotFields("REV_AMOUNT").Orientation = xlDataField
    .PivotFields("Sum of REV_AMOUNT").Function = xlSum
    .PivotFields("Sum of REV_AMOUNT").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    .PivotFields("Rma_Flag").CurrentPage = "0"
    .PivotFields("Ord_LOB").PivotItems("OTHER LOBs").Visible = False
    .PivotFields("Channelgroup").PivotItems("INTERDIV/INTERCO").Visible = False
    .PivotFields("TEAMLEAD"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End With
'    ActiveCell.PivotTable.PivotFields("TEAMLEAD"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)

'Start--------------------------------------------------------------------Select STATUS
    With ActiveSheet.PivotTables("Value").PivotFields("STATUS")
    For i = 1 To .PivotItems.Count - 1
        .PivotItems(i).Visible = False          ' <--- For/Next Unselects ALL except the last item
    Next i
    End With
    With ActiveSheet.PivotTables("Value").PivotFields("STATUS")
        .PivotItems("HG").Visible = True
        .PivotItems("HI").Visible = True
        .PivotItems("HLD1").Visible = True
        .PivotItems("HLD2").Visible = True
        .PivotItems("HO").Visible = True
    End With
    With ActiveSheet.PivotTables("Value").PivotFields("STATUS")
    i = .PivotItems.Count
        .PivotItems(i).Visible = False    ' This Deletes the last item.  ** Repeat the selection if the last item may need to be selected.
    End With
'END--------------------------------------------------------------------Select STATUS
    Columns("A:A").Select
    Selection.ColumnWidth = 9#
    Columns("B:B").Select
    Selection.ColumnWidth = 12#
    Columns("c:c").Select
    Selection.ColumnWidth = 20#
    Columns("d:d").Select
    Selection.ColumnWidth = 4#
    Columns("e:e").Select
    Selection.ColumnWidth = 12#
    Columns("f:f").Select
    Selection.ColumnWidth = 1#
    
With ActiveSheet.PivotTables("Value")
    .PivotSelect "Country_Code[All;Total] '0'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 36
    .PivotSelect "Channelgroup[All;Total] '0'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 40
'    .PivotSelect "Customer_Name[All;Total] '0'", xlDataAndLabel, True
'    Selection.Interior.ColorIndex = 44
'    .PivotSelect "CHANNELGROUP[All;Total] '0'", xlDataAndLabel, True
'    Selection.Interior.ColorIndex = 45
    .PivotSelect "'Column Grand Total'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 37
End With

'------------------------------------------------------------------------------------------------Pivot #2
Range("F1").Select
ActiveWorkbook.Worksheets(shtName).PivotTables("Value").PivotCache. _
        CreatePivotTable TableDestination:= _
        "R3C7", TableName:="Count", _
        DefaultVersion:=xlPivotTableVersion10

With ActiveSheet.PivotTables("Count")
    .AddFields RowFields:=Array("Country_Code", "TEAMLEAD", "CHANNELGROUP", "STATUS"), PageFields:=Array("Ord_LOB", "RMA_Flag")
    .PivotFields("Order_CNT_Flag").Orientation = xlDataField
    .PivotFields("Sum of Order_CNT_Flag").Function = xlSum
    .PivotFields("RMA_Flag").CurrentPage = "0"
    .PivotFields("Ord_LOB").PivotItems("OTHER LOBs").Visible = False
    .PivotFields("CHANNELGROUP").PivotItems("INTERDIV/INTERCO").Visible = False
    .PivotFields("TEAMLEAD"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End With
'    ActiveCell.PivotTable.PivotFields("TEAMLEAD"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
'Start--------------------------------------------------------------------Select STATUS
    With ActiveSheet.PivotTables("Count").PivotFields("STATUS")
    For i = 1 To .PivotItems.Count - 1
        .PivotItems(i).Visible = False          ' <--- For/Next Unselects ALL except the last item
    Next i
    End With
    With ActiveSheet.PivotTables("Count").PivotFields("STATUS")
        .PivotItems("HG").Visible = True
        .PivotItems("HI").Visible = True
        .PivotItems("HLD1").Visible = True
        .PivotItems("HLD2").Visible = True
        .PivotItems("HO").Visible = True
    End With
    With ActiveSheet.PivotTables("Count").PivotFields("STATUS")
    i = .PivotItems.Count
        .PivotItems(i).Visible = False    ' This Deletes the last item.  ** Repeat the selection if the last item may need to be selected.
    End With
'END--------------------------------------------------------------------Select STATUS
    Columns("g:g").Select
    Selection.ColumnWidth = 9#
    Columns("h:h").Select
    Selection.ColumnWidth = 12#
    Columns("i:i").Select
    Selection.ColumnWidth = 20#
    Columns("j:j").Select
    Selection.ColumnWidth = 4#
    Columns("k:k").Select
    Selection.ColumnWidth = 4#
    Columns("l:l").Select
    Selection.ColumnWidth = 1#
    
With ActiveSheet.PivotTables("Count")
    .PivotSelect "Country_Code[All;Total] '0'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 36
    .PivotSelect "Channelgroup[All;Total] '0'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 40
    .PivotSelect "'Column Grand Total'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 37
End With
    
'------------------------------------------------------------------------------------------------Pivot #3
Range("K1").Select
ActiveWorkbook.Worksheets(shtName).PivotTables("Value").PivotCache. _
        CreatePivotTable TableDestination:= _
        "R3C13", TableName:="LOB3", _
        DefaultVersion:=xlPivotTableVersion10
        
With ActiveSheet.PivotTables("LOB3")
    .AddFields RowFields:=Array("Country_Code", "TEAMLEAD", "Ord_LOB", "STATUS"), PageFields:="RMA_Flag"
    .PivotFields("REV_AMOUNT").Orientation = xlDataField
    .PivotFields("Sum of REV_AMOUNT").Function = xlSum
    .PivotFields("Sum of REV_AMOUNT").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    .PivotFields("RMA_Flag").CurrentPage = "0"
    .PivotFields("Ord_LOB").PivotItems("OTHER LOBs").Visible = False
    .PivotFields("TEAMLEAD"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End With
    
'Start--------------------------------------------------------------------Select STATUS
    With ActiveSheet.PivotTables("LOB3").PivotFields("STATUS")
    For i = 1 To .PivotItems.Count - 1
        .PivotItems(i).Visible = False          ' <--- For/Next Unselects ALL except the last item
    Next i
    End With
    With ActiveSheet.PivotTables("LOB3").PivotFields("STATUS")
        .PivotItems("HG").Visible = True
        .PivotItems("HI").Visible = True
        .PivotItems("HLD1").Visible = True
        .PivotItems("HLD2").Visible = True
        .PivotItems("HO").Visible = True
    End With
    With ActiveSheet.PivotTables("LOB3").PivotFields("STATUS")
    i = .PivotItems.Count
        .PivotItems(i).Visible = False    ' This Deletes the last item.  ** Repeat the selection if the last item may need to be selected.
    End With
'END--------------------------------------------------------------------Select STATUS
    Columns("m:m").Select
    Selection.ColumnWidth = 9#
    Columns("n:n").Select
    Selection.ColumnWidth = 12#
    Columns("o:o").Select
    Selection.ColumnWidth = 15.57
    Columns("p:p").Select
    Selection.ColumnWidth = 4#
    Columns("q:q").Select
    Selection.ColumnWidth = 12#
    Columns("r:r").Select
    Selection.ColumnWidth = 1#
    
With ActiveSheet.PivotTables("LOB3")
    .PivotSelect "Country_Code[All;Total] '0'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 36
    .PivotSelect "Ord_LOB[All;Total] '0'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 40
    .PivotSelect "'Column Grand Total'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 37
End With
    
'------------------------------------------------------------------------------------------------Pivot #4
Range("P1").Select
ActiveWorkbook.Worksheets(shtName).PivotTables("Value").PivotCache. _
        CreatePivotTable TableDestination:= _
        "R3C19", TableName:="AGED", _
        DefaultVersion:=xlPivotTableVersion10

With ActiveSheet.PivotTables("AGED")
    .AddFields RowFields:=Array("Country_Code", "TEAMLEAD", "CHANNELGROUP", "Customer_Name", "STATUS", "PARENT_ORD_BOOK_DATE", "Parent_POID"), PageFields:=Array(">50000", "RMA_Flag")
    .PivotFields("REV_AMOUNT").Orientation = xlDataField
    .PivotFields("Sum of REV_AMOUNT").Function = xlSum
    .PivotFields("Sum of REV_AMOUNT").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    .PivotFields("RMA_Flag").CurrentPage = "0"
    .PivotFields("CHANNELGROUP").PivotItems("INTERDIV/INTERCO").Visible = False
    .PivotFields("TEAMLEAD"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    .PivotFields("STATUS"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    .PivotFields("PARENT_ORD_BOOK_DATE"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End With

'Start--------------------------------------------------------------------Select STATUS
    With ActiveSheet.PivotTables("AGED").PivotFields("STATUS")
    For i = 1 To .PivotItems.Count - 1
        .PivotItems(i).Visible = False          ' <--- For/Next Unselects ALL except the last item
    Next i
    End With
    With ActiveSheet.PivotTables("AGED").PivotFields("STATUS")
        .PivotItems("HG").Visible = True
        .PivotItems("HI").Visible = True
        .PivotItems("HLD1").Visible = True
        .PivotItems("HLD2").Visible = True
        .PivotItems("HO").Visible = True
    End With
    With ActiveSheet.PivotTables("AGED").PivotFields("STATUS")
    i = .PivotItems.Count
        .PivotItems(i).Visible = False    ' This Deletes the last item.  ** Repeat the selection if the last item may need to be selected.
    End With
'END--------------------------------------------------------------------Select STATUS
    Columns("s:s").Select
    Selection.ColumnWidth = 9#
    Columns("t:t").Select
    Selection.ColumnWidth = 12#
    Columns("u:u").Select
    Selection.ColumnWidth = 15#
    Columns("v:v").Select
    Selection.ColumnWidth = 17#
    Columns("w:w").Select
    Selection.ColumnWidth = 4#
    Columns("x:x").Select
    Selection.ColumnWidth = 11#
    Columns("y:y").Select
    Selection.ColumnWidth = 14#
    Columns("z:z").Select
    Selection.ColumnWidth = 12#
    Columns("aa:aa").Select
    Selection.ColumnWidth = 1#
With ActiveSheet.PivotTables("AGED")
    .PivotSelect "Country_Code[All;Total] '0'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 36
    .PivotSelect "Customer_Name[All;Total] '0'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 44
    .PivotSelect "CHANNELGROUP[All;Total] '0'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 45
    .PivotSelect "'Column Grand Total'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 37
'    .PivotSelect "PARENT_ORD_BOOK_DATE[All;Total] '0'", xlDataAndLabel, True
'    Selection.Interior.ColorIndex = 36
'    .PivotSelect "STATUS[All;Total] '0'", xlDataAndLabel, True
'    Selection.Interior.ColorIndex = 40
End With
'---------------------------------------------------------------------------------------------Pivot #5
    Range("X1").Select
    ActiveWorkbook.Worksheets(shtName).PivotTables("Value").PivotCache. _
        CreatePivotTable TableDestination:= _
        "R3C28", TableName:="YESTERDAY", _
        DefaultVersion:=xlPivotTableVersion10
        
With ActiveSheet.PivotTables("YESTERDAY")
    .AddFields RowFields:=Array("Country_Code", "TEAMLEAD", "Ord_LOB", "STATUS", "PARENT_ORD_BOOK_DATE"), PageFields:="RMA_Flag"
    .PivotFields("REV_AMOUNT").Orientation = xlDataField
    .PivotFields("PARENT_ORD_BOOK_DATE").NumberFormat = "m/d/yyyy"   '************
    .PivotFields("Sum of REV_AMOUNT").Function = xlSum
    .PivotFields("Sum of REV_AMOUNT").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    .PivotFields("RMA_Flag").CurrentPage = "0"
    .PivotFields("Ord_LOB").PivotItems("OTHER LOBs").Visible = False
    .PivotFields("TEAMLEAD"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    .PivotFields("STATUS"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End With
'Start--------------------------------------------------------------------Select STATUS
    With ActiveSheet.PivotTables("YESTERDAY").PivotFields("STATUS")
    For i = 1 To .PivotItems.Count - 1
        .PivotItems(i).Visible = False          ' <--- For/Next Unselects ALL except the last item
    Next i
    End With
    With ActiveSheet.PivotTables("YESTERDAY").PivotFields("STATUS")
        .PivotItems("HG").Visible = True
        .PivotItems("HI").Visible = True
        .PivotItems("HLD1").Visible = True
        .PivotItems("HLD2").Visible = True
        .PivotItems("HO").Visible = True
    End With
    
    With ActiveSheet.PivotTables("YESTERDAY").PivotFields("STATUS")
    i = .PivotItems.Count
        .PivotItems(i).Visible = False    ' This Deletes the last item only.  ** Repeat the selection if the last item may need to be selected.
    End With
'END--------------------------------------------------------------------Select STATUS
    With ActiveSheet.PivotTables("YESTERDAY").PivotFields("PARENT_ORD_BOOK_DATE")
    
If Weekday(Date) = 2 Then
    For i = 1 To .PivotItems.Count - 2
        .PivotItems(i).Visible = False          ' <--- For/Next Unselects ALL except the last 2 dates on Monday
    Next i
Else
    For i = 1 To .PivotItems.Count - 1
        .PivotItems(i).Visible = False          ' <--- For/Next Unselects ALL except the last item
    Next i
End If
    
    End With
    
    Columns("ab:ab").Select
    Selection.ColumnWidth = 9#
    Columns("ac:ac").Select
    Selection.ColumnWidth = 12#
    Columns("ad:ad").Select
    Selection.ColumnWidth = 14#
    Columns("ae:ae").Select
    Selection.ColumnWidth = 5#
    Columns("Af:Af").Select
    Selection.ColumnWidth = 10#
    Columns("Ag:Ag").Select
    Selection.ColumnWidth = 12#
    Columns("Ah:Ah").Select
    Selection.ColumnWidth = 1#

With ActiveSheet.PivotTables("YESTERDAY")
    .PivotSelect "Country_Code[All;Total] '0'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 36
    .PivotSelect "Ord_LOB[All;Total] '0'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 40
End With

'---------------------------------------------------------------------------------------------Pivot #6
    Range("AD1").Select
    ActiveWorkbook.Worksheets(shtName).PivotTables("Value").PivotCache. _
        CreatePivotTable TableDestination:= _
        "R3C35", TableName:="NEXT2WEEKS", _
        DefaultVersion:=xlPivotTableVersion10
   
'Application.ScreenUpdating = False
        
With ActiveSheet.PivotTables("NEXT2WEEKS")
    .AddFields RowFields:=Array("Country_Code", "TEAMLEAD", "CHANNELGROUP", "STATUS", "RSD"), PageFields:="RMA_Flag"
    .PivotFields("REV_AMOUNT").Orientation = xlDataField
    .PivotFields("RSD").NumberFormat = "m/d/yyyy"
    .PivotFields("Sum of REV_AMOUNT").Function = xlSum
    .PivotFields("Sum of REV_AMOUNT").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    .PivotFields("RMA_Flag").CurrentPage = "0"
    .PivotFields("Ord_LOB").PivotItems("OTHER LOBs").Visible = False
    .PivotFields("CHANNELGROUP").PivotItems("INTERDIV/INTERCO").Visible = False
    .PivotFields("TEAMLEAD"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    .PivotFields("STATUS"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End With
'Start -----------------------------------------------------------------------Select Dates 10 days out.  Manual now but I'll work on auto
dtLow = DateSerial(2000, 1, 1)
dtHigh = DateSerial(Year(Date), Month(Date), Day(Date) + 14)
    
    With ActiveSheet.PivotTables("NEXT2WEEKS").PivotFields("RSD")
        For i = 1 To .PivotItems.Count '- 1
            If DateValue(.PivotItems(i).Name) <= dtHigh And _
               DateValue(.PivotItems(i).Name) >= dtLow Then
                .PivotItems(i).Visible = True
            Else
                .PivotItems(i).Visible = False
            End If
        Next i
    End With
'End -----------------------------------------------------------------------Select Dates 10 days out.

'Start--------------------------------------------------------------------Select STATUS
    With ActiveSheet.PivotTables("NEXT2WEEKS").PivotFields("STATUS")
    For i = 1 To .PivotItems.Count - 1
        .PivotItems(i).Visible = False          ' <--- For/Next Unselects ALL except the last item
    Next i
    End With
    With ActiveSheet.PivotTables("NEXT2WEEKS").PivotFields("STATUS")
        .PivotItems("HG").Visible = True
        .PivotItems("HI").Visible = True
        .PivotItems("HLD1").Visible = True
        .PivotItems("HLD2").Visible = True
        .PivotItems("HO").Visible = True
    End With
    With ActiveSheet.PivotTables("NEXT2WEEKS").PivotFields("STATUS")
    i = .PivotItems.Count
        .PivotItems(i).Visible = False    ' This Deletes the last item.  ** Repeat the selection if the last item may need to be selected.
    End With
'END--------------------------------------------------------------------Select STATUS
    Columns("Ai:Ai").Select
    Selection.ColumnWidth = 9#
    Columns("Aj:Aj").Select
    Selection.ColumnWidth = 12#
    Columns("Ak:Ak").Select
    Selection.ColumnWidth = 14#
    Columns("Al:Al").Select
    Selection.ColumnWidth = 5#
    Columns("Am:Am").Select
    Selection.ColumnWidth = 10#
    Columns("An:An").Select
    Selection.ColumnWidth = 12#
    Columns("Ao:Ao").Select
    Selection.ColumnWidth = 1#
    
With ActiveSheet.PivotTables("NEXT2WEEKS")
    .PivotSelect "Country_Code[All;Total] '0'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 36
    .PivotSelect "Channelgroup[All;Total] '0'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 40
    .PivotSelect "'Column Grand Total'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 37
End With

   Range("A3:K3,M2:Q2,S3:Z3,AB2:AN2").Interior.ColorIndex = 34
   Range("AO:AO,AH:AH,AA:AA,R:R,L:L,F:F").Interior.ColorIndex = 15
    
   Range("A3") = "Orders On Hold - Value"
   Range("G3") = "Orders On Hold - Count"
   Range("M2") = "Orders on Hold - LOB (Includes Interdiv)"
   Range("S3") = "Orders On Hold - Aged"
   Range("AB2") = "Orders on Hold - Booked Yesterday (Includes Interdiv)"
   Range("AI2") = "Orders on hold- Due Next Two weeks"
   Range("A3,G3,M2,S3,AB2,AI2").Font.Bold = True
    
    Cells.Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
    End With
   
   ActiveWindow.DisplayGridlines = False
    

'Application.ScreenUpdating = True

ActiveWorkbook.ShowPivotTableFieldList = False

'Range("A1").Select

'-------------------------------Begin >$50K > 1Week & >45 Day reports sheet -----------------------------
    Range("S1").Select
    ActiveSheet.PivotTables("AGED").PivotSelect "", xlDataAndLabel, True
    
    Selection.Copy
    
    Sheets.Add
    ActiveSheet.Paste
    ActiveSheet.Name = ">$50K >1Week & >45Days"
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Range("J1").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
    Range("I:I").Interior.ColorIndex = 15
    Range("I:I").ColumnWidth = 1
    Range("A:A").ColumnWidth = 10
    Range("B:B").ColumnWidth = 12
    Range("C:C").ColumnWidth = 16
    Range("D:D").ColumnWidth = 16
    Range("E:E").ColumnWidth = 4
    Range("F:F").ColumnWidth = 11
    Range("G:G").ColumnWidth = 12
    Range("H:H").ColumnWidth = 10
    Range("J:J").ColumnWidth = 10
    Range("K:K").ColumnWidth = 12
    Range("L:L").ColumnWidth = 16
    Range("M:M").ColumnWidth = 16
    Range("N:N").ColumnWidth = 4
    Range("O:O").ColumnWidth = 11
    Range("P:P").ColumnWidth = 12
    Range("Q:Q").ColumnWidth = 10
    
Range("A1").Select
'Start -----------------------------------------------------------------------Select Dates 7 days out. Orders On Hold - Aged   -   Over $50K and Over 1 Week
dtLow = DateSerial(2000, 1, 1)
dtHigh = DateSerial(Year(Date), Month(Date), Day(Date) - 8)
    
    With ActiveCell.PivotTable.PivotFields("PARENT_ORD_BOOK_DATE")
        For i = 1 To .PivotItems.Count   ' - 1
            If DateValue(.PivotItems(i).Name) <= dtHigh And _
               DateValue(.PivotItems(i).Name) >= dtLow Then
                .PivotItems(i).Visible = True
            Else
                .PivotItems(i).Visible = False
            End If
        Next i
    End With
'End -----------------------------------------------------------------------Select Dates 7 days out.

    ActiveCell.PivotTable.PivotFields(">50000").CurrentPage = "TRUE"
    
    Range("A1").Select
    ActiveCell.PivotTable.PivotFields("PARENT_ORD_BOOK_DATE"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
    ActiveCell.PivotTable.PivotFields("TEAMLEAD"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
    ActiveCell.PivotTable.PivotFields("STATUS").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    
    ActiveCell.PivotTable.PivotFields("Customer_Name").Subtotals _
        = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
    ActiveCell.PivotTable.PivotFields("CHANNELGROUP").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
    
'Start -----------------------------------------------------------------------Select Dates 45 days out.

Range("J1").Select

dtLow = DateSerial(2000, 1, 1)
dtHigh = DateSerial(Year(Date), Month(Date), Day(Date) - 46)
    
    With ActiveCell.PivotTable.PivotFields("PARENT_ORD_BOOK_DATE")
        For i = 1 To .PivotItems.Count   ' - 1
            If DateValue(.PivotItems(i).Name) <= dtHigh And _
               DateValue(.PivotItems(i).Name) >= dtLow Then
                .PivotItems(i).Visible = True
            Else
                .PivotItems(i).Visible = False
            End If
        Next i
    End With
'End -----------------------------------------------------------------------Select Dates 45 days out.
    
    ActiveCell.PivotTable.PivotFields("PARENT_ORD_BOOK_DATE"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
    ActiveCell.PivotTable.PivotFields("TEAMLEAD"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
    ActiveCell.PivotTable.PivotFields("STATUS").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    
    ActiveCell.PivotTable.PivotFields("Customer_Name").Subtotals _
        = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
    ActiveCell.PivotTable.PivotFields("CHANNELGROUP").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
    Range("A3").Select
    ActiveCell.FormulaR1C1 = _
        "Orders On Hold - Aged   -   Over $50K and Over 1 Week"
    Range("J3").Select
    ActiveCell.FormulaR1C1 = "Orders On Hold - Aged   -   Over 45 Calendar Days"
    
    Range("A1").Select
    
   ActiveWindow.DisplayGridlines = False

'-------------------------------End >$50K > 1Week & >45 Day reports sheet -----------------------------

'-------------------------------Begin Resellers Breakdown reports sheet -------------------------------

    Sheets("Open Orders RSD").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=10, Criteria1:="RESELLERS ORDER HOUSE"  'Field:= "Channelgroup column"
    Cells.Select
    Selection.Copy
    Sheets.Add
    ActiveSheet.Name = "temp_resellers"
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False

'usRows = ActiveSheet.UsedRange.Rows.Count                 'Were used for old version pivot creation
'usCols = ActiveSheet.UsedRange.Columns.Count
    
'Begin Example stuff-------------------------------------------------------------------------------
'Begin Example stuff-------------------------------------------------------------------------------
Worksheets.Add
ActiveSheet.Name = "Resellers"
ActiveSheet.PivotTableWizard SourceType:=xlDatabase, _
    SourceData:=Sheets("temp_resellers").UsedRange, _
    TableDestination:=ActiveCell, TableName:= _
    "ResellersBreakdown", SaveData:=True
    
With ActiveSheet.PivotTables("ResellersBreakdown")
    .AddFields RowFields:=Array("Country_Code", "TEAMLEAD", "Customer_Name", "PARENT_ORD_BOOK_DATE", "Parent_POID"), PageFields:=">50000"
    .PivotFields("REV_AMOUNT").Orientation = xlDataField
'    .PivotFields("PARENT_ORD_BOOK_DATE").NumberFormat = "d/m/yyyy"
    .PivotFields("Count of REV_AMOUNT").Function = xlSum
    .PivotFields("Sum of REV_AMOUNT").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    
    .PivotSelect "Country_Code[All;Total]", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 36
    .PivotSelect "Customer_Name[All;Total]", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 40
    .PivotSelect "PARENT_ORD_BOOK_DATE[All;Total]", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 44
    .PivotSelect "'Column Grand Total'", xlDataAndLabel, True
    Selection.Interior.ColorIndex = 37
    
    .PivotFields("TEAMLEAD").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
End With
    
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("A1").Select
'I moved all these up into the With End With above.
'    ActiveSheet.PivotTables ("ResellersBreakdown")
'    ActiveCell.PivotTable.PivotFields("TEAMLEAD").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
'    With Selection.Interior
'        .ColorIndex = 36
'        .Pattern = xlSolid
'    End With
 '   ActiveSheet.PivotTables("ResellersBreakdown").PivotSelect "Customer_Name[All;Total]", _
 '       xlDataAndLabel, True
 '   With Selection.Interior
 '       .ColorIndex = 40
 '       .Pattern = xlSolid
 '   End With
'    ActiveSheet.PivotTables("ResellersBreakdown").PivotSelect "'Column Grand Total'", _
'        xlDataAndLabel, True
'    With Selection.Interior
'        .ColorIndex = 37
'        .Pattern = xlSolid
'    End With
    Range("A2:F2").Select
    With Selection.Interior
        .ColorIndex = 34
        .Pattern = xlSolid
    End With
    Range("A1").Select
    
'---Begin Copying tables to >$50K >1Week  and >45 Days Tables -----------------------------
    ActiveCell.PivotTable.PivotSelect "", xlDataAndLabel, True
    
    Selection.Copy
    
    Range("H1").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
    Range("O1").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
'---End Copying tables to >$50K >1Week  and >45 Days Tables -----------------------------

'Start -----------------------------------------------------------------------Select Dates 7 days out.
dtLow = DateSerial(2000, 1, 1)
dtHigh = DateSerial(Year(Date), Month(Date), Day(Date) - 8)

Range("H1").Select
    With ActiveCell.PivotTable.PivotFields("PARENT_ORD_BOOK_DATE")
        For i = 1 To .PivotItems.Count - 1
            If DateValue(.PivotItems(i).Name) <= dtHigh And _
               DateValue(.PivotItems(i).Name) >= dtLow Then
                .PivotItems(i).Visible = True
            Else
                .PivotItems(i).Visible = False
            End If
        Next i
    End With
'End -----------------------------------------------------------------------Select Dates 7 days out.
    ActiveCell.PivotTable.PivotFields(">50000").CurrentPage = "TRUE"
    ActiveCell.PivotTable.PivotFields("PARENT_ORD_BOOK_DATE").Subtotals _
        = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveCell.PivotTable.PivotFields("TEAMLEAD"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveCell.PivotTable.PivotFields("Customer_Name").Subtotals _
        = Array(False, False, False, False, False, False, False, False, False, False, False, False)

'Start -----------------------------------------------------------------------Select Dates 45 days out.
dtLow = DateSerial(2000, 1, 1)
dtHigh = DateSerial(Year(Date), Month(Date), Day(Date) - 46)
    
Range("O1").Select
    With ActiveCell.PivotTable.PivotFields("PARENT_ORD_BOOK_DATE")
        For i = 1 To .PivotItems.Count - 1
            If DateValue(.PivotItems(i).Name) <= dtHigh And _
               DateValue(.PivotItems(i).Name) >= dtLow Then
                .PivotItems(i).Visible = True
            Else
                .PivotItems(i).Visible = False
            End If
        Next i
    End With
'End -----------------------------------------------------------------------Select Dates 45 days out.
    ActiveCell.PivotTable.PivotFields("PARENT_ORD_BOOK_DATE").Subtotals _
        = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveCell.PivotTable.PivotFields("TEAMLEAD"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveCell.PivotTable.PivotFields("Customer_Name").Subtotals _
        = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
    Range("G:G,N:N").Select
    Selection.Interior.ColorIndex = 15
    Selection.ColumnWidth = 1
    
    Range("A:A,H:H,O:O").Select
    Selection.ColumnWidth = 11#
    
    Range("B:B,I:I,P:P").Select
    Selection.ColumnWidth = 12#
    
    Range("C:C,J:J,Q:Q").Select
    Selection.ColumnWidth = 20#
    
    Range("D:D,K:K,R:R").Select
    Selection.ColumnWidth = 12#
    
    Range("E:E,L:L,S:S").Select
    Selection.ColumnWidth = 13#
    
    Range("F:F,M:M,T:T").Select
    Selection.ColumnWidth = 14#
    Selection.Style = "Currency"

    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Resellers Breakdown as of COB " & myStr  ' Monday date -2 calculation now done at the top (changed 06/30/03).
    Selection.Font.Bold = True
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "Resellers Breakdown as of COB " & myStr & "   -   Over $50K and Over 1 Week Old"
    Selection.Font.Bold = True
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "Resellers Breakdown as of COB " & myStr & "   -   Over 45 Calendar Days Old"
    Selection.Font.Bold = True

Cells.Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
    End With
 
Range("A1").Select
    
   ActiveWindow.DisplayGridlines = False
   
       
'-------------------------------End Resellers Breakdown reports sheet -------------------------------

'------------Begin routine to move sheets to new workbook...............................
    Sheets(shtName).Select
    Sheets(shtName).Move
    
fName = Application.GetSaveAsFilename("Voice and Data Holds COB_" & myStr, FileFilter:="Microsoft Excel Workbooks,*.xls", _
                                              Title:="Save As")
'    ActiveWorkbook.SaveAs Filename:=fName  '<-- Move this to the end.  No need saving here and at the end too.
    If fName = False Then Exit Sub      'User pressed Cancel
    On Error Resume Next
    'ActiveWorkbook.SaveAs fName
    If Err.Number <> 0 Then MsgBox Err.Description, vbExclamation, "Workbook Not Saved"
    
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("A1").Select
    Workbooks("Daily_" & myStr & "03BBS_RMAs_Details.xls").Activate
    Sheets(">$50K >1Week & >45Days").Select
    Sheets(">$50K >1Week & >45Days").Move After:= _
            Workbooks("Voice and Data Holds COB_" & myStr & ".xls").Sheets(shtName)
    Workbooks("Daily_" & myStr & "03BBS_RMAs_Details.xls").Activate
    Sheets("Resellers").Select
    Sheets("Resellers").Move After:= _
            Workbooks("Voice and Data Holds COB_" & myStr & ".xls").Sheets(">$50K >1Week & >45Days")
    Sheets(shtName).Select
      Application.DisplayAlerts = False
'    ActiveWorkbook.Save  'Same as above... hmmmm
    ActiveWorkbook.SaveAs Filename:=fName  '<-- Moved this from beginning of "move sheets" routine.
      Application.DisplayAlerts = True

Title = "All Done.  Report Saved As:"
  Msg = fName & Chr(13) & Chr(10) & Chr(10) & Chr(10) & _
        "Now just add the Data Holds that Danny Sends as the 4th tab."
Style = vbOKOnly + vbInformation
Response = MsgBox(Msg, Style, Title)


End If   'If Response = vbCancel Then            'If is at the very beginning of this procedure...

End Sub

Thanks a bunch!
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Sort by date Sort by votes
I can email some sample data if anyone is interested.

The worksheet data is 88 columns by about 40,000 rows, but I have a sample with a dozen rows.

Thanks again.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Change pivot field with a variable in VBA
Replies
4
Views
137
cogswel__cogs
C
C
  • Solved
VBA Add Pivot Table Sheet Name
Replies
1
Views
168
Anthony47
A
C
  • Question Question
Pivot Table VBA
Replies
0
Views
220
chaddres
C
S
  • Question Question
Macro for
Replies
2
Views
88
Sanderb
S
M
  • Solved
Loop through unfiltered Pivot Table items
Replies
1
Views
298
mikeymay
M

Forum statistics

Threads
1,223,665
Messages
6,173,662
Members
452,526
Latest member
azrcguy

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