Djblois
01-19-2007, 06:48 AM
Some people have been asking to see what I am doing with all this code, so here is the main module in my add-in:
Option Explicit
Option Compare Text
Public pt As PivotTable, ptCache As PivotCache
Public myInput As String, sFormula As String, pvt As Worksheet
Public pRange As Range, finalHeading As Range
Public finalColumn As Long, dataFlCount As Long, p As Long
Public sb As clsProgressBar
Sub StartPivot()
Dim nameTest As Long
Set sb = New clsProgressBar
sb.Show "Please wait", "Running...", 0
createtab:
PivotTableOptions.Show
'Create sheet
Err.Clear
myInput = PivotTableOptions.Reportname.Value
'Test if user selected at least one data value
If i = 0 Then
MsgBox "You need to select at least one value to view!"
GoTo createtab
End If
'Test if user left name blank
If (myInput) = "" Then
MsgBox "You Need to give the Report a name!"
GoTo createtab
End If
'Test if another sheet with the same name exists
If SheetExists(myInput) Then
MsgBox "You can not give two reports the same name. Please choose another name!"
PivotTableOptions.Reportname.Value = ""
GoTo createtab
End If
Set pvt = Worksheets.Add(, detail, 1)
pvt.Name = myInput
FirstProgress
finalRow = detail.Cells(65536, 1).End(xlUp).Offset(-1, 0).Row
finalColumn = detail.Cells(1, 256).End(xlToLeft).Column
detail.Activate
Set pRange = detail.Cells(1, 1).Resize(finalRow, finalColumn)
Set ptCache = Wb(1).PivotCaches.Add(SourceType:=xlDatabase, SourceData:=pRange.Address)
Set pt = ptCache.CreatePivotTable(TableDestination:=pvt.Range("A1"), TableName:="Test")
pt.RowGrand = False
pt.ManualUpdate = True
pt.DisplayErrorString = True
End Sub
Sub Customer()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#")
GoTo NextStep
End If
pvt.Activate
pt.ManualUpdate = False
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product", "Item#")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Item#", "Product")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
End Sub
Sub CustProdSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product", "SlsPrson"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product", "SlsPrson")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product", "Item#", "SlsPrson"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product", "Item#", "SlsPrson")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Item#", "Product", "SlsPrson"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Item#", "Product", "SlsPrson")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustProdTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub CustSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn")
GoTo NextStep
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustSalesTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "SlsPrsn[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub CustSalesProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrson", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrson", "Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn", "Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn", "Product", "Item#")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn", "Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn", "Item#", "Product")
GoTo NextStep
NoItemTotals
End If
NoItemTotals
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustSalesWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn", "Whse")
GoTo NextStep
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustWareProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "Product", "Item#")
GoTo NextStep
End If
NoProdTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "Item#", "Product")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustWareTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Whse[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub CustWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse")
GoTo NextStep
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustWareSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "SlsPrsn")
GoTo NextStep
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub Product()
sb.Show "Please wait", "Running...", 0
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#")
GoTo NextStep
End If
NoProdTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
pvt.Activate
pt.ManualUpdate = False
SecondProgress
End Sub
Sub ProdCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Customer", "Cust#")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustomerTotals
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
End Sub
Sub ProdCustSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Customer", "Cust#", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Customer", "Cust#", "SlsPrsn")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "Customer", "Cust#", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "Customer", "Cust#", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "Customer", "Cust#", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "Customer", "Cust#", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdCustTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub ProdCustWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Customer", "Cust#", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Customer", "Cust#", "Whse")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "Customer", "Cust#", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "Customer", "Cust#", "Whse")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "Customer", "Cust#", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "Customer", "Cust#", "Whse")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "SlsPrsn")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdSalesCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "SlsPrsn", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "SlsPrsn", "Customer", "Cust#")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "SlsPrsn", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "SlsPrsn", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "SlsPrsn", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "SlsPrsn", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustomerTotals
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdSalesTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "SlsPrsn[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub ProdSalesWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "SlsPrsn", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "SlsPrsn", "Whse")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "SlsPrsn", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "SlsPrsn", "Whse")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "SlsPrsn", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "SlsPrsn", "Whse"), ColumnFields:="Date"
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Whse")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "Whse")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "Whse")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdWareCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Whse", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Whse", "Customer", "Cust#")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "Whse", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "Whse", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "Whse", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "Whse", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustomerTotals
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdWareTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Whse[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub ProdWareSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Whse", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Whse", "SlsPrsn")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "Whse", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "Whse", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "Whse", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "Whse", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesPerson()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrson"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrson")
GoTo NextStep
End If
NextStep:
pvt.Activate
pt.ManualUpdate = False
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Item#")
GoTo NextStep
End If
NoProdTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Item#", "Product")
GoTo NextStep
End If
NoProdTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "SlsPrsn[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
End Sub
Sub SalesCustProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Product", "Item#")
GoTo NextStep
End If
NoProdTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Item#", "Product")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesCustTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "SlsPrsn[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub SalesCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#")
GoTo NextStep
End If
NextStep:
NoCustomerTotals
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesCustWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Whse")
GoTo NextStep
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesCustWareTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "SlsPrsn[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub SalesProdCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Customer", "Cust#")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Item#", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Item#", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Item#", "Product", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Item#", "Product", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustomerTotals
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesProdTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "SlsPrsn[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub SalesProdWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Whse")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Item#", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Item#", "Whse")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Item#", "Product", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Item#", "Product", "Whse")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesProdWareTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "SlsPrsn[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub WareHouse()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse")
GoTo NextStep
End If
NextStep:
pvt.Activate
pt.ManualUpdate = False
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub WareProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Product", "Item#")
GoTo NextStep
End If
NoProdTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Item#", "Product")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub WareTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Whse[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
End Sub
Sub WareProdCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Product", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Product", "Customer", "Cust#")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Product", "Item#", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Product", "Item#", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Item#", "Product", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Item#", "Product", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustomerTotals
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub WareProdTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Whse[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub WareProdSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Product", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Product", "SlsPrsn")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Product", "Item#", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Product", "Item#", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Item#", "Product", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Item#", "Product", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub WareProdSalesTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Whse[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub WareCustProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "Product", "Item#")
GoTo NextStep
End If
NoCustTotal
NoProdTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "Item#", "Product")
GoTo NextStep
End If
NoCustTotal
NoItemTotals
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub WareCustTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Whse[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub WareCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#")
GoTo NextStep
End If
NextStep:
NoCustomerTotals
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub WareCustSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "SlsPrsn")
GoTo NextStep
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub WareCustSalesTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Whse[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub PFGShipto()
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
InputName:
PFGoptions.Show
myInput = PFGoptions.Reportname.Value
If (myInput) = "" Then
MsgBox "You Need to give the Report a name before it will run."
GoTo InputName
End If
If SheetExists(myInput) Then
MsgBox "You can not give two reports the same name. Please choose another name!"
PivotTableOptions.Reportname.Value = ""
GoTo InputName
End If
Set pvt = Worksheets.Add(, detail, 1)
pvt.Name = myInput
finalRow = detail.Cells(65536, 1).End(xlUp).Offset(-1, 0).Row
finalColumn = detail.Cells(1, 100).End(xlToLeft).Column
detail.Activate
Set pRange = detail.Cells(1, 1).Resize(finalRow, finalColumn)
Set ptCache = Wb(1).PivotCaches.Add(SourceType:=xlDatabase, SourceData:=pRange.Address)
Set pt = ptCache.CreatePivotTable(TableDestination:=pvt.Range("A1"), TableName:="Test")
pt.RowGrand = False
pt.ManualUpdate = True
'Add Fields to Pivot Table
SalesReports.Hide
On Error Resume Next
If PFGoptions.NO.Value = True Then
pt.AddFields RowFields:=Array("Product"), ColumnFields:="Customer"
End If
If PFGoptions.Yes.Value = True Then
pt.AddFields RowFields:=Array("Product", "Item#"), ColumnFields:="Customer"
NoProdTotals
End If
pt.ManualUpdate = False
pvt.Activate
ActiveSheet.PageSetup.PrintTitleRows = "$2:$2"
Range("A3").Select
ActiveWindow.FreezePanes = True
If PFGoptions.Cases.Value = True Then
AddCases
End If
If PFGoptions.Profit.Value = True Then
AddProfit
End If
With Range(Range("IV2").End(xlToLeft), "A2")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
If PFGoptions.NO.Value = True Then
Range("B2").Select
End If
If PFGoptions.Yes.Value = True Then
Range("C2").Select
End If
With Range(Selection, Selection.End(xlToRight))
.Orientation = 45
.BorderAround xlContinuous, xlThin, 1
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).Weight = xlThin
.Borders(xlInsideHorizontal).ColorIndex = 1
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideVertical).ColorIndex = 1
End With
EndPivot
With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With
Application.ScreenUpdating = True
End Sub
Sub OrderSheet()
'Create sheet
Err.Clear
myInput = "Order Sheet"
sb.Show "Please wait", "Running...", 0
If SheetExists(myInput) Then
MsgBox "You have already created an Order Sheet for this File"
PivotTableOptions.Reportname.Value = ""
End
End If
Set pvt = Worksheets.Add(, detail, 1)
pvt.Name = myInput
finalRow = detail.Cells(65536, 1).End(xlUp).Offset(-1, 0).Row
finalColumn = detail.Cells(1, 256).End(xlToLeft).Column
detail.Activate
Set pRange = detail.Cells(1, 1).Resize(finalRow, finalColumn)
Set ptCache = Wb(1).PivotCaches.Add(SourceType:=xlDatabase, SourceData:=pRange.Address)
Set pt = ptCache.CreatePivotTable(TableDestination:=pvt.Range("A1"), TableName:="Test")
pt.RowGrand = False
pt.ColumnGrand = False
pt.ManualUpdate = True
pt.DisplayErrorString = True
If OrderSheetOptions.Yes.Value = True Then
pt.AddFields RowFields:=Array("Customer", "Product", "Item#")
NoCustomerTotals
NoProdTotals
AddDate
pt.ManualUpdate = False
Application.DisplayAlerts = False
pvt.Activate
If OrderSheetOptions.OrderForm.Value = True Then
Range("E2").FormulaR1C1 = "Date_______ Qty"
Range("F2").FormulaR1C1 = "Date_______ Qty"
Range("G2").FormulaR1C1 = "Date_______ Qty"
With Range("A2", "C2")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
With Range("E2", "G2")
.HorizontalAlignment = xlLeft
.Interior.ColorIndex = 2
.Font.ColorIndex = 5
.WrapText = True
.ColumnWidth = 9.7
End With
'Create border around cells
Range("D2").End(xlDown).Select
ActiveCell.Offset(0, 1).Resize(1, 3).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.BorderAround xlContinuous, xlThin, 1
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).Weight = xlThin
Selection.Borders(xlInsideHorizontal).ColorIndex = 1
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).Weight = xlThin
Selection.Borders(xlInsideVertical).ColorIndex = 1
pt.PivotFields("Customer").LayoutPageBreak = True
pvt.PageSetup.RightFooter = ""
Range("D2").Font.ColorIndex = 1
Range("D2").Interior.ColorIndex = 1
End If
If OrderSheetOptions.Report.Value = True Then
With Range("A2", "C2")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
Range("D2").Font.ColorIndex = 1
Range("D2").Interior.ColorIndex = 1
End If
End If
If OrderSheetOptions.NO.Value = True Then
pt.AddFields RowFields:=Array("Customer", "Product")
NoCustomerTotals
NoProdTotals
AddDate
pt.ManualUpdate = False
Application.DisplayAlerts = False
pvt.Activate
If OrderSheetOptions.OrderForm.Value = True Then
Range("D2").FormulaR1C1 = "Date_______ Qty"
Range("E2").FormulaR1C1 = "Date_______ Qty"
Range("F2").FormulaR1C1 = "Date_______ Qty"
With Range("A2", "B2")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
With Range("D2", "F2")
.HorizontalAlignment = xlLeft
.Interior.ColorIndex = 2
.Font.ColorIndex = 5
.WrapText = True
.ColumnWidth = 9.7
End With
Dim rng As Range
Range("C2").End(xlDown).Select
ActiveCell.Offset(0, 1).Resize(1, 3).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.BorderAround xlContinuous, xlThin, 1
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).Weight = xlThin
Selection.Borders(xlInsideHorizontal).ColorIndex = 1
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).Weight = xlThin
Selection.Borders(xlInsideVertical).ColorIndex = 1
pt.PivotFields("Customer").LayoutPageBreak = True
pvt.PageSetup.RightFooter = ""
Range("C2").Font.ColorIndex = 1
Range("C2").Interior.ColorIndex = 1
End If
If OrderSheetOptions.Report.Value = True Then
With Range("A2", "B2")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
Range("C2").Font.ColorIndex = 1
Range("C2").Interior.ColorIndex = 1
End If
End If
Rows("1:1").EntireRow.Hidden = True
Set pRange = Nothing
Set ptCache = Nothing
PrintHeadingPvt
Application.CommandBars("PivotTable").Visible = False
ActiveWorkbook.ShowPivotTableFieldList = False
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Font.Size = 8
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Columns.AutoFit
Set pvt = Nothing
Set pt = Nothing
ActiveWorkbook.Save
Application.DisplayAlerts = True
Range("A2").Select
End Sub
Sub InvoiceDate()
'Add Fields to Pivot table
sb.Show "Please wait", "Running...", 0
SalesReports.Hide
On Error Resume Next
pt.AddFields RowFields:=Array("Customer", "Cust#", "Date", "Invoice#", "Product")
NoCustTotal
AddCases
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Date[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
pt.PivotSelect "Invoice#[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 40
Selection.Font.Bold = True
With Range(Range("IV2").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
ActiveSheet.PageSetup.PrintTitleRows = "$2:$2"
Range("A3").Select
ActiveWindow.FreezePanes = True
End Sub
Sub InvoiceProduct()
sb.Show "Please wait", "Running...", 0
'Add Fields to Pivot Table
pt.AddFields RowFields:=Array("Invoice#", "Date", "Customer", "Cust#", "SlsPrsn", "Product", "Price ($)", "Unit Cost ($)")
NoDateTotals
NoCustomerTotals
NoCustTotal
NoSlsTotals
NoProdTotals
NoPriceTotals
NoUnitCostTotals
AddCases
AddUnits
AddAmt
AddTotalCost
AddProfit
AddPercentage
With pt.DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Invoice#[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
With Range(Range("IV2").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.WrapText = True
End With
'set printheading
PrintHeadingPvt
With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With
Range("A3").Select
ActiveWindow.FreezePanes = True
End Sub
Sub InvoiceSummary()
sb.Show "Please wait", "Running...", 0
'Add Fields to Pivot Table
pt.AddFields RowFields:=Array("Invoice#", "Date", "Customer", "Cust#", "SlsPrsn")
NoDateTotals
NoCustomerTotals
NoCustTotal
NoSlsTotals
NoInvoiceTotals
AddCases
AddUnits
AddAmt
AddTotalCost
AddProfit
AddPercentage
With pt.DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
With Range(Range("IV2").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
'set printheading
PrintHeadingPvt
With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With
finalRow = Cells(65536, 1).End(xlUp).Row
For i = 3 To finalRow Step 2
Cells(i, 1).Resize(1, 11).Interior.ColorIndex = 34
Next
Range("A3").Select
ActiveWindow.FreezePanes = True
End Sub
Sub SalesReportOptions()
Application.DisplayAlerts = False
sFormula = "SUMPRODUCT(--(YEAR(B2:B" & Cells(Rows.Count, 2).End(xlUp).Row & _
")=YEAR(B2)))=COUNT(B2:B" & Cells(Rows.Count, 2).End(xlUp).Row & ")"
If i = 1 Then
If PivotTableOptions.Cases.Value = True Then
AddCases
GoTo EndData
End If
If PivotTableOptions.Amount.Value = True Then
AddAmt
GoTo EndData
End If
If PivotTableOptions.Profit.Value = True Then
AddProfit
GoTo EndData
End If
If PivotTableOptions.ProfitPerc.Value = True Then
AddPercentage
GoTo EndData
End If
If PivotTableOptions.Units.Value = True Then
AddUnits
GoTo EndData
End If
If PivotTableOptions.Cost.Value = True Then
AddTotalCost
GoTo EndData
End If
If PivotTableOptions.UnitCost.Value = True Then
AddUnitCost
GoTo EndData
End If
If PivotTableOptions.Price.Value = True Then
AddPrice
GoTo EndData
End If
Else
If PivotTableOptions.Cases.Value = True Then
AddCases
End If
If PivotTableOptions.Amount.Value = True Then
AddAmt
End If
If PivotTableOptions.Profit.Value = True Then
AddProfit
End If
If PivotTableOptions.ProfitPerc.Value = True Then
AddPercentage
End If
If PivotTableOptions.Units.Value = True Then
AddUnits
End If
If PivotTableOptions.Cost.Value = True Then
AddTotalCost
End If
If PivotTableOptions.UnitCost.Value = True Then
AddUnitCost
End If
If PivotTableOptions.Price.Value = True Then
AddPrice
End If
End If
EndData:
If PivotTableOptions.Month.Value = True Then
byMonth
If i > 1 Then
'If detail.Evaluate(sFormula) = 1 Then
'With pt.DataPivotField
'.Orientation = xlColumnField
'.Position = 2
'End With
'With Range(Range("IV3").End(xlToLeft), "A1")
'.HorizontalAlignment = xlCenter
'.Font.Bold = True
'.Font.ColorIndex = 2
'.Interior.ColorIndex = 5
'.Columns.AutoFit
'End With
'Else
With pt.DataPivotField
.Orientation = xlColumnField
.Position = 3
End With
With Range(Range("IV4").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
'End If
End If
GoTo EndDate
End If
If PivotTableOptions.Quarter.Value = True Then
byQuarter
If i > 1 Then
'If detail.Evaluate(sFormula) = 1 Then
'With pt.DataPivotField
'.Orientation = xlColumnField
'.Position = 2
'End With
'With Range(Range("IV3").End(xlToLeft), "A1")
'.HorizontalAlignment = xlCenter
'.Font.Bold = True
'.Font.ColorIndex = 2
'.Interior.ColorIndex = 5
'.Columns.AutoFit
'End With
'Else
With pt.DataPivotField
.Orientation = xlColumnField
.Position = 3
End With
With Range(Range("IV4").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
'End If
End If
GoTo EndDate
End If
If PivotTableOptions.Year.Value = True Then
byYear
If i > 1 Then
'With pt.DataPivotField
'.Orientation = xlColumnField
'.Position = 2
'End With
'With Range(Range("IV3").End(xlToLeft), "A1")
'.HorizontalAlignment = xlCenter
'.Font.Bold = True
'.Font.ColorIndex = 2
'.Interior.ColorIndex = 5
'.Columns.AutoFit
'End With
End If
GoTo EndDate
End If
If PivotTableOptions.Week.Value = True Then
byWeek
If i > 1 Then
With pt.DataPivotField
.Orientation = xlColumnField
.Position = 3
End With
With Range(Range("IV3").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
End If
GoTo EndDate
End If
If PivotTableOptions.Day.Value = True Then
byDay
If i > 1 Then
'If detail.Evaluate(sFormula) = 1 Then
'With pt.DataPivotField
'.Orientation = xlColumnField
'.Position = 2
'End With
'With Range(Range("IV2").End(xlToLeft), "A1")
'.HorizontalAlignment = xlCenter
'.Font.Bold = True
'.Font.ColorIndex = 2
'.Interior.ColorIndex = 5
'.Columns.AutoFit
'End With
'Else
With pt.DataPivotField
.Orientation = xlColumnField
.Position = 3
End With
With Range(Range("IV3").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
'End If
End If
GoTo EndDate
End If
If PivotTableOptions.NoDate.Value = True Then
If i > 1 Then
With pt.DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
With Range(Range("IV2").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
End If
GoTo EndDate
End If
EndDate:
If PivotTableOptions.Landscape.Value = True Then
With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With
End If
Application.DisplayAlerts = True
Application.CommandBars("PivotTable").Visible = False
ThirdProgress
End Sub
Sub byDay()
pt.ManualUpdate = False
Application.DisplayAlerts = False
'If detail.Evaluate(sFormula) = 1 Then
'If PivotTableOptions.Descending.Value = True Then
'pt.PivotFields("Date").AutoSort xlDescending, "Date"
'End If
'End If
'If detail.Evaluate(sFormula) > 1 Then
If PivotTableOptions.Descending.Value = True Then
pt.PivotFields("Date").AutoSort xlDescending, "Date"
pt.PivotFields("Years").AutoSort xlDescending, "Years"
End If
'End If
'Format Column Headings
pvt.Activate
Range("IV2").Select
Selection.End(xlToLeft).Select
Range(Selection, "A2").Select
ColumnHeadings
ActiveSheet.PageSetup.PrintTitleRows = "$2:$3"
Range("A4").Select
ActiveWindow.FreezePanes = True
Application.DisplayAlerts = True
End Sub
Sub byWeek()
Dim firstdate, whichday, startdate As Date
pt.ManualUpdate = False
Application.DisplayAlerts = False
Dim pf As PivotField
Set pf = pt.PivotFields("Date")
firstdate = pt.PivotFields("Date").LabelRange.Offset(1, 0).Value
whichday = Application.WorksheetFunction.Weekday(firstdate, 3)
startdate = firstdate - whichday
pt.PivotFields("Date").LabelRange.Group _
Start:=startdate, End:=True, By:=7, _
Periods:=Array(False, False, False, True, False, False, False)
If PivotTableOptions.Descending.Value = True Then
pt.PivotFields("Date").AutoSort xlDescending, "Date"
End If
'Format Column Headings
pvt.Activate
Range("IV2").Select
Selection.End(xlToLeft).Select
Set finalHeading = ActiveCell
Range(Selection, "A2").RowHeight = 23.25
ColumnHeadings
Rows("1:1").Select
Selection.Find(What:="Date", After:=ActiveCell).Select
ActiveCell.Offset(1, 0).Select
Range(Selection, finalHeading).Select
With Selection
.WrapText = True
.ColumnWidth = 10
End With
ActiveSheet.PageSetup.PrintTitleRows = "$2:$3"
Range("A4").Select
ActiveWindow.FreezePanes = True
Application.DisplayAlerts = True
End Sub
Sub byMonth()
pt.ManualUpdate = False
Application.DisplayAlerts = False
Dim pf As PivotField
sFormula = "SUMPRODUCT(--(YEAR(B2:B" & Cells(Rows.Count, 2).End(xlUp).Row & _
")=YEAR(B2)))=COUNT(B2:B" & Cells(Rows.Count, 2).End(xlUp).Row & ")"
Set pf = pt.PivotFields("Date")
'If detail.Evaluate(sFormula) = 1 Then
'pf.LabelRange.Group Start:=True, End:=True, Periods:=Array(False, False, False _
', False, True, False, False)
'If PivotTableOptions.Descending.Value = True Then
'pt.PivotFields("Date").AutoSort xlDescending, "Date"
'End If
'End If
'If detail.Evaluate(sFormula) > 1 Then
pf.LabelRange.Group Start:=True, End:=True, Periods:=Array(False, False, False _
, False, True, False, True)
If PivotTableOptions.Descending.Value = True Then
pt.PivotFields("Date").AutoSort xlDescending, "Date"
pt.PivotFields("Years").AutoSort xlDescending, "Years"
End If
'End If
'Format Column Headings
pvt.Activate
Range("IV3").Select
Selection.End(xlToLeft).Select
Range(Selection, "A1").Select
ColumnHeadings
ActiveSheet.PageSetup.PrintTitleRows = "$2:$3"
Range("A4").Select
ActiveWindow.FreezePanes = True
Application.DisplayAlerts = True
End Sub
Sub byQuarter()
pt.ManualUpdate = False
Application.DisplayAlerts = False
Dim pf As PivotField
Set pf = pt.PivotFields("Date")
'If detail.Evaluate(sFormula) = 1 Then
'pf.LabelRange.Group Start:=True, End:=True, Periods:=Array(False, False, False _
', False, False, True, True)
'If PivotTableOptions.Descending.Value = True Then
'pt.PivotFields("Date").AutoSort xlDescending, "Date"
'End If
'End If
'If detail.Evaluate(sFormula) > 1 Then
pf.LabelRange.Group Start:=True, End:=True, Periods:=Array(False, False, False _
, False, False, True, True)
If PivotTableOptions.Descending.Value = True Then
pt.PivotFields("Date").AutoSort xlDescending, "Date"
pt.PivotFields("Years").AutoSort xlDescending, "Years"
End If
'End If
'Set Print Heading
pvt.Activate
Range("IV3").Select
Selection.End(xlToLeft).Select
Range(Selection, "A1").Select
ColumnHeadings
ActiveSheet.PageSetup.PrintTitleRows = "$2:$3"
Range("A4").Select
ActiveWindow.FreezePanes = True
Application.DisplayAlerts = True
End Sub
Sub byYear()
pt.ManualUpdate = False
Application.DisplayAlerts = False
Dim pf As PivotField
Set pf = pt.PivotFields("Date")
pf.LabelRange.Group Start:=True, End:=True, Periods:=Array(False, False, False _
, False, False, False, True)
If PivotTableOptions.Descending.Value = True Then
pt.PivotFields("Date").AutoSort xlDescending, "Date"
End If
'Set Print Heading
pvt.Activate
Range("IV2").Select
Selection.End(xlToLeft).Select
Range(Selection, "A1").Select
ColumnHeadings
ActiveSheet.PageSetup.PrintTitleRows = "$2:$2"
Range("A3").Select
ActiveWindow.FreezePanes = True
End Sub
Sub EndPivot()
'Highlight Grand Total
pt.PivotSelect "'Column Grand Total'", xlDataAndLabel, True
Selection.Font.ColorIndex = 2
Selection.Interior.ColorIndex = 5
Selection.Font.Bold = True
Rows("1:1").EntireRow.Hidden = True
ActiveWorkbook.ShowPivotTableFieldList = False
Application.CommandBars("PivotTable").Visible = False
PrintHeadingPvt
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Font.Size = 8
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Columns.AutoFit
Application.DisplayAlerts = True
FourthProgress
Set pRange = Nothing
Set ptCache = Nothing
Set pt = Nothing
Set pvt = Nothing
Range("A2").Select
End Sub
It all works exactly like I need with minor problems which I have posted in other threads. I am not asking for help here but if anyone wants to recommend an easier way to do something or shorter code or anything, it is appreciated.
Option Explicit
Option Compare Text
Public pt As PivotTable, ptCache As PivotCache
Public myInput As String, sFormula As String, pvt As Worksheet
Public pRange As Range, finalHeading As Range
Public finalColumn As Long, dataFlCount As Long, p As Long
Public sb As clsProgressBar
Sub StartPivot()
Dim nameTest As Long
Set sb = New clsProgressBar
sb.Show "Please wait", "Running...", 0
createtab:
PivotTableOptions.Show
'Create sheet
Err.Clear
myInput = PivotTableOptions.Reportname.Value
'Test if user selected at least one data value
If i = 0 Then
MsgBox "You need to select at least one value to view!"
GoTo createtab
End If
'Test if user left name blank
If (myInput) = "" Then
MsgBox "You Need to give the Report a name!"
GoTo createtab
End If
'Test if another sheet with the same name exists
If SheetExists(myInput) Then
MsgBox "You can not give two reports the same name. Please choose another name!"
PivotTableOptions.Reportname.Value = ""
GoTo createtab
End If
Set pvt = Worksheets.Add(, detail, 1)
pvt.Name = myInput
FirstProgress
finalRow = detail.Cells(65536, 1).End(xlUp).Offset(-1, 0).Row
finalColumn = detail.Cells(1, 256).End(xlToLeft).Column
detail.Activate
Set pRange = detail.Cells(1, 1).Resize(finalRow, finalColumn)
Set ptCache = Wb(1).PivotCaches.Add(SourceType:=xlDatabase, SourceData:=pRange.Address)
Set pt = ptCache.CreatePivotTable(TableDestination:=pvt.Range("A1"), TableName:="Test")
pt.RowGrand = False
pt.ManualUpdate = True
pt.DisplayErrorString = True
End Sub
Sub Customer()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#")
GoTo NextStep
End If
pvt.Activate
pt.ManualUpdate = False
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product", "Item#")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Item#", "Product")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
End Sub
Sub CustProdSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product", "SlsPrson"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product", "SlsPrson")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product", "Item#", "SlsPrson"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Product", "Item#", "SlsPrson")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Item#", "Product", "SlsPrson"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Item#", "Product", "SlsPrson")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustProdTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub CustSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn")
GoTo NextStep
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustSalesTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "SlsPrsn[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub CustSalesProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrson", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrson", "Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn", "Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn", "Product", "Item#")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn", "Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn", "Item#", "Product")
GoTo NextStep
NoItemTotals
End If
NoItemTotals
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustSalesWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "SlsPrsn", "Whse")
GoTo NextStep
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustWareProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "Product", "Item#")
GoTo NextStep
End If
NoProdTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "Item#", "Product")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustWareTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Whse[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub CustWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse")
GoTo NextStep
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustWareSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Customer", "Cust#", "Whse", "SlsPrsn")
GoTo NextStep
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub Product()
sb.Show "Please wait", "Running...", 0
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#")
GoTo NextStep
End If
NoProdTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
pvt.Activate
pt.ManualUpdate = False
SecondProgress
End Sub
Sub ProdCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Customer", "Cust#")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustomerTotals
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
End Sub
Sub ProdCustSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Customer", "Cust#", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Customer", "Cust#", "SlsPrsn")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "Customer", "Cust#", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "Customer", "Cust#", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "Customer", "Cust#", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "Customer", "Cust#", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdCustTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub ProdCustWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Customer", "Cust#", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Customer", "Cust#", "Whse")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "Customer", "Cust#", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "Customer", "Cust#", "Whse")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "Customer", "Cust#", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "Customer", "Cust#", "Whse")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "SlsPrsn")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdSalesCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "SlsPrsn", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "SlsPrsn", "Customer", "Cust#")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "SlsPrsn", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "SlsPrsn", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "SlsPrsn", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "SlsPrsn", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustomerTotals
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdSalesTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "SlsPrsn[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub ProdSalesWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "SlsPrsn", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "SlsPrsn", "Whse")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "SlsPrsn", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "SlsPrsn", "Whse")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "SlsPrsn", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "SlsPrsn", "Whse"), ColumnFields:="Date"
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Whse")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "Whse")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "Whse")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdWareCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Whse", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Whse", "Customer", "Cust#")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "Whse", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "Whse", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "Whse", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "Whse", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustomerTotals
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdWareTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Whse[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub ProdWareSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Whse", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Whse", "SlsPrsn")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Product", "Item#", "Whse", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Product", "Item#", "Whse", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Item#", "Product", "Whse", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Item#", "Product", "Whse", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesPerson()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrson"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrson")
GoTo NextStep
End If
NextStep:
pvt.Activate
pt.ManualUpdate = False
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Item#")
GoTo NextStep
End If
NoProdTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Item#", "Product")
GoTo NextStep
End If
NoProdTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "SlsPrsn[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
End Sub
Sub SalesCustProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Product", "Item#")
GoTo NextStep
End If
NoProdTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Item#", "Product")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesCustTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "SlsPrsn[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub SalesCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#")
GoTo NextStep
End If
NextStep:
NoCustomerTotals
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesCustWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Customer", "Cust#", "Whse")
GoTo NextStep
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesCustWareTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "SlsPrsn[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub SalesProdCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Customer", "Cust#")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Item#", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Item#", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Item#", "Product", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Item#", "Product", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustomerTotals
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesProdTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "SlsPrsn[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub SalesProdWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Whse")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Item#", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Product", "Item#", "Whse")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("SlsPrsn", "Item#", "Product", "Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("SlsPrsn", "Item#", "Product", "Whse")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub SalesProdWareTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "SlsPrsn[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub WareHouse()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse")
GoTo NextStep
End If
NextStep:
pvt.Activate
pt.ManualUpdate = False
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub WareProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Product", "Item#")
GoTo NextStep
End If
NoProdTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Item#", "Product")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub WareTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Whse[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
End Sub
Sub WareProdCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Product", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Product", "Customer", "Cust#")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Product", "Item#", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Product", "Item#", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Item#", "Product", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Item#", "Product", "Customer", "Cust#")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
NoCustomerTotals
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub WareProdTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Whse[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub WareProdSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Product", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Product", "SlsPrsn")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Product", "Item#", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Product", "Item#", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Item#", "Product", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Item#", "Product", "SlsPrsn")
GoTo NextStep
End If
NoItemTotals
End If
NextStep:
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub WareProdSalesTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Whse[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Product[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub WareCustProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.Controls(NO).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "Product")
GoTo NextStep
End If
End If
If PivotTableOptions.Controls(SBP).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "Product", "Item#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "Product", "Item#")
GoTo NextStep
End If
NoCustTotal
NoProdTotals
End If
If PivotTableOptions.Controls(SBI).Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "Item#", "Product"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "Item#", "Product")
GoTo NextStep
End If
NoCustTotal
NoItemTotals
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub WareCustTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Whse[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub WareCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#")
GoTo NextStep
End If
NextStep:
NoCustomerTotals
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub WareCustSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "SlsPrsn"), ColumnFields:="Date"
GoTo NextStep
Else
pt.AddFields RowFields:=Array("Whse", "Customer", "Cust#", "SlsPrsn")
GoTo NextStep
End If
NextStep:
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub WareCustSalesTotals()
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Whse[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
End Sub
Sub PFGShipto()
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
InputName:
PFGoptions.Show
myInput = PFGoptions.Reportname.Value
If (myInput) = "" Then
MsgBox "You Need to give the Report a name before it will run."
GoTo InputName
End If
If SheetExists(myInput) Then
MsgBox "You can not give two reports the same name. Please choose another name!"
PivotTableOptions.Reportname.Value = ""
GoTo InputName
End If
Set pvt = Worksheets.Add(, detail, 1)
pvt.Name = myInput
finalRow = detail.Cells(65536, 1).End(xlUp).Offset(-1, 0).Row
finalColumn = detail.Cells(1, 100).End(xlToLeft).Column
detail.Activate
Set pRange = detail.Cells(1, 1).Resize(finalRow, finalColumn)
Set ptCache = Wb(1).PivotCaches.Add(SourceType:=xlDatabase, SourceData:=pRange.Address)
Set pt = ptCache.CreatePivotTable(TableDestination:=pvt.Range("A1"), TableName:="Test")
pt.RowGrand = False
pt.ManualUpdate = True
'Add Fields to Pivot Table
SalesReports.Hide
On Error Resume Next
If PFGoptions.NO.Value = True Then
pt.AddFields RowFields:=Array("Product"), ColumnFields:="Customer"
End If
If PFGoptions.Yes.Value = True Then
pt.AddFields RowFields:=Array("Product", "Item#"), ColumnFields:="Customer"
NoProdTotals
End If
pt.ManualUpdate = False
pvt.Activate
ActiveSheet.PageSetup.PrintTitleRows = "$2:$2"
Range("A3").Select
ActiveWindow.FreezePanes = True
If PFGoptions.Cases.Value = True Then
AddCases
End If
If PFGoptions.Profit.Value = True Then
AddProfit
End If
With Range(Range("IV2").End(xlToLeft), "A2")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
If PFGoptions.NO.Value = True Then
Range("B2").Select
End If
If PFGoptions.Yes.Value = True Then
Range("C2").Select
End If
With Range(Selection, Selection.End(xlToRight))
.Orientation = 45
.BorderAround xlContinuous, xlThin, 1
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).Weight = xlThin
.Borders(xlInsideHorizontal).ColorIndex = 1
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideVertical).ColorIndex = 1
End With
EndPivot
With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With
Application.ScreenUpdating = True
End Sub
Sub OrderSheet()
'Create sheet
Err.Clear
myInput = "Order Sheet"
sb.Show "Please wait", "Running...", 0
If SheetExists(myInput) Then
MsgBox "You have already created an Order Sheet for this File"
PivotTableOptions.Reportname.Value = ""
End
End If
Set pvt = Worksheets.Add(, detail, 1)
pvt.Name = myInput
finalRow = detail.Cells(65536, 1).End(xlUp).Offset(-1, 0).Row
finalColumn = detail.Cells(1, 256).End(xlToLeft).Column
detail.Activate
Set pRange = detail.Cells(1, 1).Resize(finalRow, finalColumn)
Set ptCache = Wb(1).PivotCaches.Add(SourceType:=xlDatabase, SourceData:=pRange.Address)
Set pt = ptCache.CreatePivotTable(TableDestination:=pvt.Range("A1"), TableName:="Test")
pt.RowGrand = False
pt.ColumnGrand = False
pt.ManualUpdate = True
pt.DisplayErrorString = True
If OrderSheetOptions.Yes.Value = True Then
pt.AddFields RowFields:=Array("Customer", "Product", "Item#")
NoCustomerTotals
NoProdTotals
AddDate
pt.ManualUpdate = False
Application.DisplayAlerts = False
pvt.Activate
If OrderSheetOptions.OrderForm.Value = True Then
Range("E2").FormulaR1C1 = "Date_______ Qty"
Range("F2").FormulaR1C1 = "Date_______ Qty"
Range("G2").FormulaR1C1 = "Date_______ Qty"
With Range("A2", "C2")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
With Range("E2", "G2")
.HorizontalAlignment = xlLeft
.Interior.ColorIndex = 2
.Font.ColorIndex = 5
.WrapText = True
.ColumnWidth = 9.7
End With
'Create border around cells
Range("D2").End(xlDown).Select
ActiveCell.Offset(0, 1).Resize(1, 3).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.BorderAround xlContinuous, xlThin, 1
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).Weight = xlThin
Selection.Borders(xlInsideHorizontal).ColorIndex = 1
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).Weight = xlThin
Selection.Borders(xlInsideVertical).ColorIndex = 1
pt.PivotFields("Customer").LayoutPageBreak = True
pvt.PageSetup.RightFooter = ""
Range("D2").Font.ColorIndex = 1
Range("D2").Interior.ColorIndex = 1
End If
If OrderSheetOptions.Report.Value = True Then
With Range("A2", "C2")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
Range("D2").Font.ColorIndex = 1
Range("D2").Interior.ColorIndex = 1
End If
End If
If OrderSheetOptions.NO.Value = True Then
pt.AddFields RowFields:=Array("Customer", "Product")
NoCustomerTotals
NoProdTotals
AddDate
pt.ManualUpdate = False
Application.DisplayAlerts = False
pvt.Activate
If OrderSheetOptions.OrderForm.Value = True Then
Range("D2").FormulaR1C1 = "Date_______ Qty"
Range("E2").FormulaR1C1 = "Date_______ Qty"
Range("F2").FormulaR1C1 = "Date_______ Qty"
With Range("A2", "B2")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
With Range("D2", "F2")
.HorizontalAlignment = xlLeft
.Interior.ColorIndex = 2
.Font.ColorIndex = 5
.WrapText = True
.ColumnWidth = 9.7
End With
Dim rng As Range
Range("C2").End(xlDown).Select
ActiveCell.Offset(0, 1).Resize(1, 3).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.BorderAround xlContinuous, xlThin, 1
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).Weight = xlThin
Selection.Borders(xlInsideHorizontal).ColorIndex = 1
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).Weight = xlThin
Selection.Borders(xlInsideVertical).ColorIndex = 1
pt.PivotFields("Customer").LayoutPageBreak = True
pvt.PageSetup.RightFooter = ""
Range("C2").Font.ColorIndex = 1
Range("C2").Interior.ColorIndex = 1
End If
If OrderSheetOptions.Report.Value = True Then
With Range("A2", "B2")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
Range("C2").Font.ColorIndex = 1
Range("C2").Interior.ColorIndex = 1
End If
End If
Rows("1:1").EntireRow.Hidden = True
Set pRange = Nothing
Set ptCache = Nothing
PrintHeadingPvt
Application.CommandBars("PivotTable").Visible = False
ActiveWorkbook.ShowPivotTableFieldList = False
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Font.Size = 8
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Columns.AutoFit
Set pvt = Nothing
Set pt = Nothing
ActiveWorkbook.Save
Application.DisplayAlerts = True
Range("A2").Select
End Sub
Sub InvoiceDate()
'Add Fields to Pivot table
sb.Show "Please wait", "Running...", 0
SalesReports.Hide
On Error Resume Next
pt.AddFields RowFields:=Array("Customer", "Cust#", "Date", "Invoice#", "Product")
NoCustTotal
AddCases
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Customer[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
pt.PivotSelect "Date[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 37
Selection.Font.Bold = True
pt.PivotSelect "Invoice#[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 40
Selection.Font.Bold = True
With Range(Range("IV2").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
ActiveSheet.PageSetup.PrintTitleRows = "$2:$2"
Range("A3").Select
ActiveWindow.FreezePanes = True
End Sub
Sub InvoiceProduct()
sb.Show "Please wait", "Running...", 0
'Add Fields to Pivot Table
pt.AddFields RowFields:=Array("Invoice#", "Date", "Customer", "Cust#", "SlsPrsn", "Product", "Price ($)", "Unit Cost ($)")
NoDateTotals
NoCustomerTotals
NoCustTotal
NoSlsTotals
NoProdTotals
NoPriceTotals
NoUnitCostTotals
AddCases
AddUnits
AddAmt
AddTotalCost
AddProfit
AddPercentage
With pt.DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
pt.PivotSelect "Invoice#[All;Total]", xlDataAndLabel, True
Selection.Interior.ColorIndex = 15
Selection.Font.Bold = True
With Range(Range("IV2").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.WrapText = True
End With
'set printheading
PrintHeadingPvt
With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With
Range("A3").Select
ActiveWindow.FreezePanes = True
End Sub
Sub InvoiceSummary()
sb.Show "Please wait", "Running...", 0
'Add Fields to Pivot Table
pt.AddFields RowFields:=Array("Invoice#", "Date", "Customer", "Cust#", "SlsPrsn")
NoDateTotals
NoCustomerTotals
NoCustTotal
NoSlsTotals
NoInvoiceTotals
AddCases
AddUnits
AddAmt
AddTotalCost
AddProfit
AddPercentage
With pt.DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
'Highlight Cust Totals
pvt.Activate
pt.ManualUpdate = False
With Range(Range("IV2").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
'set printheading
PrintHeadingPvt
With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With
finalRow = Cells(65536, 1).End(xlUp).Row
For i = 3 To finalRow Step 2
Cells(i, 1).Resize(1, 11).Interior.ColorIndex = 34
Next
Range("A3").Select
ActiveWindow.FreezePanes = True
End Sub
Sub SalesReportOptions()
Application.DisplayAlerts = False
sFormula = "SUMPRODUCT(--(YEAR(B2:B" & Cells(Rows.Count, 2).End(xlUp).Row & _
")=YEAR(B2)))=COUNT(B2:B" & Cells(Rows.Count, 2).End(xlUp).Row & ")"
If i = 1 Then
If PivotTableOptions.Cases.Value = True Then
AddCases
GoTo EndData
End If
If PivotTableOptions.Amount.Value = True Then
AddAmt
GoTo EndData
End If
If PivotTableOptions.Profit.Value = True Then
AddProfit
GoTo EndData
End If
If PivotTableOptions.ProfitPerc.Value = True Then
AddPercentage
GoTo EndData
End If
If PivotTableOptions.Units.Value = True Then
AddUnits
GoTo EndData
End If
If PivotTableOptions.Cost.Value = True Then
AddTotalCost
GoTo EndData
End If
If PivotTableOptions.UnitCost.Value = True Then
AddUnitCost
GoTo EndData
End If
If PivotTableOptions.Price.Value = True Then
AddPrice
GoTo EndData
End If
Else
If PivotTableOptions.Cases.Value = True Then
AddCases
End If
If PivotTableOptions.Amount.Value = True Then
AddAmt
End If
If PivotTableOptions.Profit.Value = True Then
AddProfit
End If
If PivotTableOptions.ProfitPerc.Value = True Then
AddPercentage
End If
If PivotTableOptions.Units.Value = True Then
AddUnits
End If
If PivotTableOptions.Cost.Value = True Then
AddTotalCost
End If
If PivotTableOptions.UnitCost.Value = True Then
AddUnitCost
End If
If PivotTableOptions.Price.Value = True Then
AddPrice
End If
End If
EndData:
If PivotTableOptions.Month.Value = True Then
byMonth
If i > 1 Then
'If detail.Evaluate(sFormula) = 1 Then
'With pt.DataPivotField
'.Orientation = xlColumnField
'.Position = 2
'End With
'With Range(Range("IV3").End(xlToLeft), "A1")
'.HorizontalAlignment = xlCenter
'.Font.Bold = True
'.Font.ColorIndex = 2
'.Interior.ColorIndex = 5
'.Columns.AutoFit
'End With
'Else
With pt.DataPivotField
.Orientation = xlColumnField
.Position = 3
End With
With Range(Range("IV4").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
'End If
End If
GoTo EndDate
End If
If PivotTableOptions.Quarter.Value = True Then
byQuarter
If i > 1 Then
'If detail.Evaluate(sFormula) = 1 Then
'With pt.DataPivotField
'.Orientation = xlColumnField
'.Position = 2
'End With
'With Range(Range("IV3").End(xlToLeft), "A1")
'.HorizontalAlignment = xlCenter
'.Font.Bold = True
'.Font.ColorIndex = 2
'.Interior.ColorIndex = 5
'.Columns.AutoFit
'End With
'Else
With pt.DataPivotField
.Orientation = xlColumnField
.Position = 3
End With
With Range(Range("IV4").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
'End If
End If
GoTo EndDate
End If
If PivotTableOptions.Year.Value = True Then
byYear
If i > 1 Then
'With pt.DataPivotField
'.Orientation = xlColumnField
'.Position = 2
'End With
'With Range(Range("IV3").End(xlToLeft), "A1")
'.HorizontalAlignment = xlCenter
'.Font.Bold = True
'.Font.ColorIndex = 2
'.Interior.ColorIndex = 5
'.Columns.AutoFit
'End With
End If
GoTo EndDate
End If
If PivotTableOptions.Week.Value = True Then
byWeek
If i > 1 Then
With pt.DataPivotField
.Orientation = xlColumnField
.Position = 3
End With
With Range(Range("IV3").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
End If
GoTo EndDate
End If
If PivotTableOptions.Day.Value = True Then
byDay
If i > 1 Then
'If detail.Evaluate(sFormula) = 1 Then
'With pt.DataPivotField
'.Orientation = xlColumnField
'.Position = 2
'End With
'With Range(Range("IV2").End(xlToLeft), "A1")
'.HorizontalAlignment = xlCenter
'.Font.Bold = True
'.Font.ColorIndex = 2
'.Interior.ColorIndex = 5
'.Columns.AutoFit
'End With
'Else
With pt.DataPivotField
.Orientation = xlColumnField
.Position = 3
End With
With Range(Range("IV3").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
'End If
End If
GoTo EndDate
End If
If PivotTableOptions.NoDate.Value = True Then
If i > 1 Then
With pt.DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
With Range(Range("IV2").End(xlToLeft), "A1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.Columns.AutoFit
End With
End If
GoTo EndDate
End If
EndDate:
If PivotTableOptions.Landscape.Value = True Then
With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With
End If
Application.DisplayAlerts = True
Application.CommandBars("PivotTable").Visible = False
ThirdProgress
End Sub
Sub byDay()
pt.ManualUpdate = False
Application.DisplayAlerts = False
'If detail.Evaluate(sFormula) = 1 Then
'If PivotTableOptions.Descending.Value = True Then
'pt.PivotFields("Date").AutoSort xlDescending, "Date"
'End If
'End If
'If detail.Evaluate(sFormula) > 1 Then
If PivotTableOptions.Descending.Value = True Then
pt.PivotFields("Date").AutoSort xlDescending, "Date"
pt.PivotFields("Years").AutoSort xlDescending, "Years"
End If
'End If
'Format Column Headings
pvt.Activate
Range("IV2").Select
Selection.End(xlToLeft).Select
Range(Selection, "A2").Select
ColumnHeadings
ActiveSheet.PageSetup.PrintTitleRows = "$2:$3"
Range("A4").Select
ActiveWindow.FreezePanes = True
Application.DisplayAlerts = True
End Sub
Sub byWeek()
Dim firstdate, whichday, startdate As Date
pt.ManualUpdate = False
Application.DisplayAlerts = False
Dim pf As PivotField
Set pf = pt.PivotFields("Date")
firstdate = pt.PivotFields("Date").LabelRange.Offset(1, 0).Value
whichday = Application.WorksheetFunction.Weekday(firstdate, 3)
startdate = firstdate - whichday
pt.PivotFields("Date").LabelRange.Group _
Start:=startdate, End:=True, By:=7, _
Periods:=Array(False, False, False, True, False, False, False)
If PivotTableOptions.Descending.Value = True Then
pt.PivotFields("Date").AutoSort xlDescending, "Date"
End If
'Format Column Headings
pvt.Activate
Range("IV2").Select
Selection.End(xlToLeft).Select
Set finalHeading = ActiveCell
Range(Selection, "A2").RowHeight = 23.25
ColumnHeadings
Rows("1:1").Select
Selection.Find(What:="Date", After:=ActiveCell).Select
ActiveCell.Offset(1, 0).Select
Range(Selection, finalHeading).Select
With Selection
.WrapText = True
.ColumnWidth = 10
End With
ActiveSheet.PageSetup.PrintTitleRows = "$2:$3"
Range("A4").Select
ActiveWindow.FreezePanes = True
Application.DisplayAlerts = True
End Sub
Sub byMonth()
pt.ManualUpdate = False
Application.DisplayAlerts = False
Dim pf As PivotField
sFormula = "SUMPRODUCT(--(YEAR(B2:B" & Cells(Rows.Count, 2).End(xlUp).Row & _
")=YEAR(B2)))=COUNT(B2:B" & Cells(Rows.Count, 2).End(xlUp).Row & ")"
Set pf = pt.PivotFields("Date")
'If detail.Evaluate(sFormula) = 1 Then
'pf.LabelRange.Group Start:=True, End:=True, Periods:=Array(False, False, False _
', False, True, False, False)
'If PivotTableOptions.Descending.Value = True Then
'pt.PivotFields("Date").AutoSort xlDescending, "Date"
'End If
'End If
'If detail.Evaluate(sFormula) > 1 Then
pf.LabelRange.Group Start:=True, End:=True, Periods:=Array(False, False, False _
, False, True, False, True)
If PivotTableOptions.Descending.Value = True Then
pt.PivotFields("Date").AutoSort xlDescending, "Date"
pt.PivotFields("Years").AutoSort xlDescending, "Years"
End If
'End If
'Format Column Headings
pvt.Activate
Range("IV3").Select
Selection.End(xlToLeft).Select
Range(Selection, "A1").Select
ColumnHeadings
ActiveSheet.PageSetup.PrintTitleRows = "$2:$3"
Range("A4").Select
ActiveWindow.FreezePanes = True
Application.DisplayAlerts = True
End Sub
Sub byQuarter()
pt.ManualUpdate = False
Application.DisplayAlerts = False
Dim pf As PivotField
Set pf = pt.PivotFields("Date")
'If detail.Evaluate(sFormula) = 1 Then
'pf.LabelRange.Group Start:=True, End:=True, Periods:=Array(False, False, False _
', False, False, True, True)
'If PivotTableOptions.Descending.Value = True Then
'pt.PivotFields("Date").AutoSort xlDescending, "Date"
'End If
'End If
'If detail.Evaluate(sFormula) > 1 Then
pf.LabelRange.Group Start:=True, End:=True, Periods:=Array(False, False, False _
, False, False, True, True)
If PivotTableOptions.Descending.Value = True Then
pt.PivotFields("Date").AutoSort xlDescending, "Date"
pt.PivotFields("Years").AutoSort xlDescending, "Years"
End If
'End If
'Set Print Heading
pvt.Activate
Range("IV3").Select
Selection.End(xlToLeft).Select
Range(Selection, "A1").Select
ColumnHeadings
ActiveSheet.PageSetup.PrintTitleRows = "$2:$3"
Range("A4").Select
ActiveWindow.FreezePanes = True
Application.DisplayAlerts = True
End Sub
Sub byYear()
pt.ManualUpdate = False
Application.DisplayAlerts = False
Dim pf As PivotField
Set pf = pt.PivotFields("Date")
pf.LabelRange.Group Start:=True, End:=True, Periods:=Array(False, False, False _
, False, False, False, True)
If PivotTableOptions.Descending.Value = True Then
pt.PivotFields("Date").AutoSort xlDescending, "Date"
End If
'Set Print Heading
pvt.Activate
Range("IV2").Select
Selection.End(xlToLeft).Select
Range(Selection, "A1").Select
ColumnHeadings
ActiveSheet.PageSetup.PrintTitleRows = "$2:$2"
Range("A3").Select
ActiveWindow.FreezePanes = True
End Sub
Sub EndPivot()
'Highlight Grand Total
pt.PivotSelect "'Column Grand Total'", xlDataAndLabel, True
Selection.Font.ColorIndex = 2
Selection.Interior.ColorIndex = 5
Selection.Font.Bold = True
Rows("1:1").EntireRow.Hidden = True
ActiveWorkbook.ShowPivotTableFieldList = False
Application.CommandBars("PivotTable").Visible = False
PrintHeadingPvt
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Font.Size = 8
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Columns.AutoFit
Application.DisplayAlerts = True
FourthProgress
Set pRange = Nothing
Set ptCache = Nothing
Set pt = Nothing
Set pvt = Nothing
Range("A2").Select
End Sub
It all works exactly like I need with minor problems which I have posted in other threads. I am not asking for help here but if anyone wants to recommend an easier way to do something or shorter code or anything, it is appreciated.