PDA

View Full Version : Taste of my addin



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.

Bob Phillips
01-19-2007, 07:15 AM
A short synopsis of the code would help, save us guessing.

lucas
01-19-2007, 08:23 AM
Daniel has missed the point completely. See this thread for a background to this post:
http://www.vbaexpress.com/forum/showthread.php?t=11077

Djblois
01-19-2007, 08:49 AM
No Lucas I didn't miss the point. I explained what my code did in that thread. However Norie seemed curious to why my code is so long. I posted it mainly because of what she said, not you. However, I figured it might be useful for myself and other people by posting it.

For anyone who didn't read that thread, It is an addin I created for my company to do reporting (Basically it is a dumbed down way of making Pivot tables and much quicker also). My Reports look professional when they come out and I am always adding based upon user requests.

moa
01-19-2007, 09:55 AM
:think: Wow, that is a lot of code. A lot of redundancy too. Just had a quick browse but you really could use some loops. Do you know about passing parameters to subs/functions?

If you were to leave your job and someone else had to enhance your code it would be a little daunting.

Djblois
01-19-2007, 10:16 AM
Moa,

Can you explain? I am a beginner. Also, no one at my job, could even do this much.

Norie
01-19-2007, 10:32 AM
Why all the Gotos?

A large majority of them are just redundant.

You cannnot use Goto to jump to a place in another sub.

From VBA Help:

GoTo can branch only to lines within the procedure where it appears.
Also using Goto is generally frowned upon, as it just makes code hard to
understand and hard to follow the flow.

PS Moa is right there is a lot of redundancy mainly due to repetition.

Note these are only my first observations, I'll take a closer look later.:)

Djblois
01-19-2007, 10:41 AM
Well the gotos I added in are to skip the other if statements to speed up the code. It is faster since I put them in. I am trying to make things as fast as possible. Also my addin doesn't go through all that code every time. It depends on the button that the user pushes. Here is an example:

Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Customer-SalesPerson-WareHouse"
PivotTableOptions.Reportname.Value = "Customer-SalesPerson-WareHouse"
StartPivot
CustSalesWare
SalesReportOptions
CustSalesTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True

that is the code that runs when the user pushes the Customer SalesPerson Warehouse button.

Norie
01-19-2007, 11:01 AM
Did you not see the quote from help?

For example here Goto NextStep is redundant.

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

Djblois
01-19-2007, 11:13 AM
I fixed that problem about 5 minutes ago but I can see what you mean in that case. But a lot of places it has other if statements to go through. I will remove the Goto from any spots that only have one if. Thank you for the tip. If you have anymore it would be appreciated.

Norie
01-19-2007, 11:40 AM
It's nothing to do with the If.:)

Djblois
01-19-2007, 02:14 PM
Norie,

Can you please explain then because the reason I use the Goto's is in many places there are more if's after the first one that don't make sense if they already recieved a true in a previous if, so I have it skip the rest of the if's so it speeds it up.

Daniel

CBrine
01-19-2007, 02:24 PM
I haven't reviewed the code, but from your comments an If...then...goto just obsucifates your code and makes it impossible to follow. If would be better to do this type of structure.


If ..... Then
Your Code
If ..... Then
Your Code
Select Case YourVariable
Case 1
Your Code
Case 2
Your Code
End Select
End If
Else
If..... Then
Your Code
Else
Your Code
End if
End if



HTH
Cal

PS


However Norie seemed curious to why my code is so long. I posted it mainly because of what she said, not you. However, I figured it might be useful for myself and other people by posting it.

Norie? I always thought you were a guy? Are you a girl or guy? Maybe just from my malecentric veiwpoint I just assumed that?:-)

Norie
01-19-2007, 02:34 PM
Daniel

I'm also having trouble 'deciphering' the code.

I counted 173 Gotos, there are also various calls to other subs/functions.

And there's also many undefined/undeclared variables.

And then there seem to be references to a userform, I think.:)

Like I said earlier if the code works, it works, but as someone else (Moa) pointed out if this code is inherited by someone else it's going to be difficult to work with and maintain.

Cal

Last time I looked I was a guy.:)

Maybe the name's confusing.

If you do a web search all you get are puffins, boats and Japanese women - in reverse order last time I looked.

Djblois
01-19-2007, 02:42 PM
Sorry for mistaking you for a women. Also, thank you I just removed many more gotos. I have about 25% of the gotos that I used to have now. I noticed a lot of them were redundant. However some are in places that aren't redundant. I am trying to make the code easier to read and work with. I also want to get better.

Djblois
01-19-2007, 02:44 PM
CBrine,

Thank you for the tip. I have never used Select Case. In this case would it work when the if statements are testing controls?

CBrine
01-22-2007, 09:36 AM
Djblois,
I haven't reviewed your code, so I'm not sure what you are doing, but you are able to use the Select case with anything you use an If statement with. For controls it would be something like this.



Select Case userform1.ListBox1.text
Case "A"
Your Code
Case "B"
Your Code
Case "C"
Your Code
Case Else
Your Code
End Select


HTH
Cal

Norie
01-22-2007, 01:13 PM
Daniel

Just done another count, 64 subs?:bug:

And a lot of them look pretty similar.:)

Cal

I'm not sure Select Case would be particularly useful here unless the whole code/add-in was restructured/rewritten.

CBrine
01-22-2007, 01:59 PM
Norie,
I'll bow to you on that one. I went cross eyed after looking at the code for about 20 seconds. I was only giving him an example of how to code in a well structured way, based on your comments about goto's. Course it sounds like the whole code does need to be restructured.
:-)

Cal
PS-Glad to hear that you are a guy.

CBrine
01-22-2007, 02:00 PM
What the heck? I didn't post all those 10 other posts?

Norie
01-22-2007, 02:04 PM
Cal

I think Select Case could probably be used here but not to replace the If End Ifs.

Like I said I counted 64 subs and a lot of them seem pretty similar.

lucas
01-22-2007, 02:17 PM
Ha Ha Cal......went a little nut's on you didn't it? It's happened before. They are deleted.

CBrine
01-22-2007, 02:38 PM
Thanks lucas....It was like a running commentary of my edits.

PS. I think the problem may have to do with the textbox being entered and the post quick reply both having focus at the same time somehow?

Djblois
07-17-2007, 09:03 AM
For anybody who wants to see, I have rewritten most of my code and it looks like this now. I am reusing a lot more code which reduced the size drastically. However, as I shrink the code this way, I have also added a lot more features that in turn increased the size again. Again I am not asking for help, just wanted to show everyone what I have done with thier help (Which I greatly appreciate) and I still welcome any comments.

Option Explicit
Option Compare Text
Sub Customer()

comFormName PivotTableOptions, "Customer", "Customer", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "Customer", "Cust#" 'Adds Pivot Table Fields
ptNoTotal "Customer"
ptReportOptions PivotTableOptions
EndSalesReport PivotTableOptions, 2

End Sub
Sub CustProd()

comFormName PivotTableOptions, "Customer-Product", "Cust-Prod", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow4 "Customer", "Cust#", "Product", "Item#" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
TestProductSubtotals
ptCreateTotals "Customer[All;Total]", 15
EndSalesReport PivotTableOptions, 2
End Sub
Sub CustProdSales()

comFormName PivotTableOptions, "Customer-Product-SalesPerson", "Cust-Prod-Sales", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow5 "Customer", "Cust#", "Product", "Item#", "SlsPrsn" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
TestProductSubtotals
ptCreateTotals "Customer[All;Total]", 15
EndSalesReport PivotTableOptions, 2
End Sub
Sub CustProdWare()

comFormName PivotTableOptions, "Customer-Product-WareHouse", "Cust-Prod-Whse", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow5 "Customer", "Cust#", "Product", "Item#", "Whse" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
TestProductSubtotals
ptCreateTotals "Customer[All;Total]", 15
EndSalesReport PivotTableOptions, 2

End Sub
Sub CustSales()

comFormName PivotTableOptions, "Customer-SalesPerson", "Cust-Sales", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "Customer", "Cust#" 'Adds Pivot Table Fields
ptAddRowField "SlsPrsn" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
ptCreateTotals "Customer[All;Total]", 15
EndSalesReport PivotTableOptions, 2
End Sub
Sub CustSalesTotals()
'Highlight Cust Totals
ptCreateTotals "Customer[All;Total]", 15
ptCreateTotals "SlsPrsn[All;Total]", 37

End Sub
Sub CustSalesProd()

comFormName PivotTableOptions, "Customer-SalesPerson-Product", "Cust-Sales-Prod", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow5 "Customer", "Cust#", "SlsPrsn", "Product", "Item#" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
TestProductSubtotals
ptCreateTotals "Customer[All;Total]", 15
EndSalesReport PivotTableOptions, 2
End Sub
Sub CustSalesWare()

comFormName PivotTableOptions, "Customer-SalesPerson-WareHouse", "Cust-Sales-Whse", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "Customer", "Cust#" 'Adds Pivot Table Fields
ptAddRowField "SlsPrsn", "Whse" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
CustSalesTotals
EndSalesReport PivotTableOptions, 2

End Sub
Sub CustWareProd()

comFormName PivotTableOptions, "Customer-WareHouse-Product", "Cust-Whse-Prod", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow5 "Customer", "Cust#", "Whse", "Product", "Item#" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
TestProductSubtotals
CustWareTotals
EndSalesReport PivotTableOptions, 2

End Sub
Sub CustWareTotals()

'Highlight Cust Totals
ptCreateTotals "Customer[All;Total]", 15
ptCreateTotals "Whse[All;Total]", 37
End Sub
Sub CustWare()

comFormName PivotTableOptions, "Customer-WareHouse", "Cust-Whse", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
'Add Fields to Pivot Table
ptAddRowField "Customer", "Cust#" 'Adds Pivot Table Fields
ptAddRowField "Whse" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
ptCreateTotals "Customer[All;Total]", 15
EndSalesReport PivotTableOptions, 2

End Sub
Sub CustWareSales()

comFormName PivotTableOptions, "Customer-WareHouse-SalesPerson", "Cust-Ware-Sales", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "Customer", "Cust#" 'Adds Pivot Table Fields
ptAddRowField "Whse", "SlsPrsn" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
CustWareTotals
EndSalesReport PivotTableOptions, 2

End Sub
Sub Product()

comFormName PivotTableOptions, "Product", "Product", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow2 "Product", "Item#" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
TestProductSubtotals
EndSalesReport PivotTableOptions, 2

End Sub
Sub ProdCust()

comFormName PivotTableOptions, "Product-Customer", "Prod-Cust", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow4 "Product", "Item#", "Customer", "Cust#" 'Adds Pivot Table Fields
ptNoTotal "Customer"
ptReportOptions PivotTableOptions
ptCreateTotals "Product[All;Total]", 15
EndSalesReport PivotTableOptions, 2

End Sub
Sub ProdCustSales()

comFormName PivotTableOptions, "Product-Customer-SalesPerson", "Prod-Cust-Sales", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow5 "Product", "Item#", "Customer", "Cust#", "SlsPrsn" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
ProdCustTotals
EndSalesReport PivotTableOptions, 2

End Sub

Sub ProdCustTotals()

'Highlight Cust Totals
ptCreateTotals "Product[All;Total]", 15
ptCreateTotals "Customer[All;Total]", 37
End Sub
Sub ProdCustWare()

comFormName PivotTableOptions, "Product-Customer-WareHouse", "Prod-Cust-Whse", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow5 "Product", "Item#", "Customer", "Cust#", "Whse" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
ProdCustTotals
EndSalesReport PivotTableOptions, 2

End Sub
Sub ProdSales()

comFormName PivotTableOptions, "Product-SalesPerson-Customer", "Prod-Sales-Cust", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow3 "Product", "Item#", "SlsPrsn" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
ptCreateTotals "Product[All;Total]", 15
EndSalesReport PivotTableOptions, 2
End Sub
Sub ProdSalesCust()

comFormName PivotTableOptions, "Product-SalesPerson-Customer", "Prod-Sales-Cust", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow5 "Product", "Item#", "SlsPrsn", "Customer", "Cust#" 'Adds Pivot Table Fields
ptNoTotal "Customer"
ptReportOptions PivotTableOptions
ProdSalesTotals
EndSalesReport PivotTableOptions, 2
End Sub
Sub ProdSalesTotals()

'Highlight Cust Totals
ptCreateTotals "Product[All;Total]", 15
ptCreateTotals "SlsPrsn[All;Total]", 37
End Sub
Sub ProdSalesWare()

comFormName PivotTableOptions, "Product-SalesPerson-WareHouse", "Prod-Sales-Whse", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow4 "Product", "Item#", "SlsPrsn", "Whse" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
ProdSalesTotals
EndSalesReport PivotTableOptions, 2

End Sub
Sub ProdWare()

comFormName PivotTableOptions, "Product-WareHouse", "Prod-Whse", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow3 "Product", "Item#", "Whse" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
ptCreateTotals "Product[All;Total]", 15
EndSalesReport PivotTableOptions, 2
End Sub
Sub ProdWareCust()

comFormName PivotTableOptions, "Customer-Product-WareHouse", "Cust-Prod-Whse", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow5 "Product", "Item#", "Whse", "Customer", "Cust#" 'Adds Pivot Table Fields
ptNoTotal "Customer"
ptReportOptions PivotTableOptions
ProdWareTotals
EndSalesReport PivotTableOptions, 2

End Sub
Sub ProdWareTotals()

'Highlight Cust Totals
ptCreateTotals "Product[All;Total]", 15
ptCreateTotals "Whse[All;Total]", 37
End Sub
Sub ProdWareSales()

comFormName PivotTableOptions, "Product-WareHouse-SalesPerson", "Prod-Whse-Sales", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow4 "Product", "Item#", "Whse", "SlsPrsn" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
ProdWareTotals
EndSalesReport PivotTableOptions, 2
End Sub
Sub SalesPrsn()

comFormName PivotTableOptions, "SalesPerson", "SalesPerson", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "SlsPrsn" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
EndSalesReport PivotTableOptions, 2
End Sub
Sub SalesProd()

comFormName PivotTableOptions, "SalesPerson-Product", "Sales-Prod", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow3 "SlsPrsn", "Product", "Item#" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
TestProductSubtotals
ptCreateTotals "SlsPrsn[All;Total]", 15
EndSalesReport PivotTableOptions, 2

End Sub
Sub SalesCustProd()

comFormName PivotTableOptions, "SalesPerson-Customer-Product", "Sales-Cust-Prod", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow5 "SlsPrsn", "Customer", "Cust#", "Product", "Item#" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
TestProductSubtotals
SalesCustTotals
EndSalesReport PivotTableOptions, 2

End Sub
Sub SalesCustTotals()

'Highlight Cust Totals
ptCreateTotals "SlsPrsn[All;Total]", 15
ptCreateTotals "Customer[All;Total]", 37
End Sub
Sub SalesCust()

comFormName PivotTableOptions, "SalesPerson-Customer", "Sales-Cust", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "SlsPrsn", "Customer" 'Adds Pivot Table Fields
ptAddRowField "Cust#" 'Adds Pivot Table Fields
ptNoTotal "Customer"
ptReportOptions PivotTableOptions
ptCreateTotals "SlsPrsn[All;Total]", 15
EndSalesReport PivotTableOptions, 2

End Sub
Sub SalesCustWare()

comFormName PivotTableOptions, "SalesPerson-Customer-WareHouse", "Sales-Cust-Whse", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "SlsPrsn", "Customer" 'Adds Pivot Table Fields
ptAddRowField "Cust#", "Whse" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
SalesCustTotals
EndSalesReport PivotTableOptions, 2

End Sub
Sub SalesProdCust()

comFormName PivotTableOptions, "SalesPerson-Product-Customer", "Sales-Prod-Cust", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow5 "SlsPrsn", "Product", "Item#", "Customer", "Cust#" 'Adds Pivot Table Fields
ptNoTotal "Customer"
ptReportOptions PivotTableOptions
TestProductSubtotals
ptCreateTotals "SlsPrsn[All;Total]", 15
EndSalesReport PivotTableOptions, 2
End Sub
Sub SalesProdWare()

comFormName PivotTableOptions, "SalesPerson-Product-WareHouse", "Sales-Prod-Whse", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow4 "SlsPrsn", "Product", "Item#", "Whse" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
TestProductSubtotals
ptCreateTotals "SlsPrsn[All;Total]", 15
EndSalesReport PivotTableOptions, 2
End Sub
Sub SalesWare()

comFormName PivotTableOptions, "SalesPerson-WareHouse", "Sales-Whse", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "SlsPrsn", "Whse" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
ptCreateTotals "SlsPrsn[All;Total]", 15
EndSalesReport PivotTableOptions, 2

End Sub
Sub SalesWareCust()

comFormName PivotTableOptions, "SalesPerson-WareHouse-Customer", "Sales-Whse-Cust", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "SlsPrsn", "Whse" 'Adds Pivot Table Fields
ptAddRowField "Customer", "Cust#" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
SalesWareTotals
EndSalesReport PivotTableOptions, 2
End Sub
Sub SalesWareTotals()

'Highlight Cust Totals
ptCreateTotals "SlsPrsn[All;Total]", 15
ptCreateTotals "Whse[All;Total]", 37

End Sub
Sub SalesWareProd()

comFormName PivotTableOptions, "SalesPerson-WareHouse-Product", "Sales-Whse-Prod", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow4 "SlsPrsn", "Whse", "Product", "Item#" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
TestProductSubtotals
SalesWareTotals
EndSalesReport PivotTableOptions, 2

End Sub
Sub WareHouse()

comFormName PivotTableOptions, "WareHouse", "WareHouse", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "Whse" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
EndSalesReport PivotTableOptions, 2
End Sub
Sub WareProd()

comFormName PivotTableOptions, "WareHouse-Product", "Whse-Prod", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow3 "Whse", "Product", "Item#" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
TestProductSubtotals
ptCreateTotals "Whse[All;Total]", 15
EndSalesReport PivotTableOptions, 2

End Sub
Sub WareProdCust()

comFormName PivotTableOptions, "WareHouse-Product-Customer", "Whse-Prod-Customer", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow5 "Whse", "Product", "Item#", "Customer", "Cust#" 'Adds Pivot Table Fields
ptNoTotal "Customer"
ptReportOptions PivotTableOptions
TestProductSubtotals
ptCreateTotals "Whse[All;Total]", 15
EndSalesReport PivotTableOptions, 2

End Sub
Sub WareProdSales()

comFormName PivotTableOptions, "WareHouse-Product-SalesPerson", "Whse-Prod-Sales", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow4 "Whse", "Product", "Item#", "SlsPrsn" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
TestProductSubtotals
ptCreateTotals "Whse[All;Total]", 15
EndSalesReport PivotTableOptions, 2

End Sub
Sub WareCustProd()

comFormName PivotTableOptions, "WareHouse-Customer-Product", "Whse-Cust-Prod", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow5 "Whse", "Customer", "Cust#", "Product", "Item#" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
TestProductSubtotals
WareCustTotals
EndSalesReport PivotTableOptions, 2
End Sub
Sub WareCustTotals()

'Highlight Cust Totals
ptCreateTotals "Whse[All;Total]", 15
ptCreateTotals "Customer[All;Total]", 37
End Sub
Sub WareCust()

comFormName PivotTableOptions, "WareHouse-Customer", "Whse-Cust", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "Whse", "Customer" 'Adds Pivot Table Fields
ptAddRowField "Cust#" 'Adds Pivot Table Fields
ptNoTotal "Customer"
ptReportOptions PivotTableOptions
ptCreateTotals "Whse[All;Total]", 15
EndSalesReport PivotTableOptions, 2

End Sub
Sub WareCustSales()

comFormName PivotTableOptions, "WareHouse-Customer-SalesPerson", "Whse-Cust-Sales", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "Whse", "Customer" 'Adds Pivot Table Fields
ptAddRowField "Cust#", "SlsPrsn" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
WareCustTotals
EndSalesReport PivotTableOptions, 2
End Sub
Sub WareSales()

comFormName PivotTableOptions, "WareHouse-SalesPerson", "Whse-Sales", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "Whse", "SlsPrsn" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
ptCreateTotals "Whse[All;Total]", 15
EndSalesReport PivotTableOptions, 2
End Sub
Sub WareSalesCust()

comFormName PivotTableOptions, "WareHouse-SalesPerson-Customer", "Whse-Sales-Cust", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "Whse", "SlsPrsn" 'Adds Pivot Table Fields
ptAddRowField "Customer", "Cust#" 'Adds Pivot Table Fields
ptNoTotal "Customer"
ptReportOptions PivotTableOptions
WareSalesTotals
EndSalesReport PivotTableOptions, 2
End Sub
Sub WareSalesTotals()

'Highlight Cust Totals
ptCreateTotals "Whse[All;Total]", 15
ptCreateTotals "SlsPrsn[All;Total]", 37
End Sub
Sub WareSalesProd()

comFormName PivotTableOptions, "WareHouse-SalesPerson-Product", "Whse-Sales-Prod", SalesReports
AddCode
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptChooseProdRow4 "Whse", "SlsPrsn", "Product", "Item#" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
TestProductSubtotals
WareSalesTotals
EndSalesReport PivotTableOptions, 2

End Sub
Sub ChoosePvtColumnHeading(ByVal objDataForm As Object)

Dim lgWeek As Long

ResizeAndFit 'Resize Columns and Change font to 8
pagsetAdjustPageWidth "Normal" 'Adjust Page Width based on Total Column Widths
errUpdateLogFile "Sub-" & "ChoosePvtColumnHeading", "objDataForm " & objDataForm.Name 'Log Current sub
'Select Options based on Amount of Data Options chosen and the Date Group
If i = 1 And Not objDataForm.cbShowChange Then
If objDataForm.obMonth Or objDataForm.obQuarter Then
PagSetColHeads Range(Range("IV3").End(xlToLeft), "A2"), 2, 5, False
PagSetFreezeRow Range("A4"), "$2:$3", Rows("1:1")
ElseIf objDataForm.obYear Then
PagSetColHeads Range(Range("IV2").End(xlToLeft), "A2"), 2, 5, False
PagSetFreezeRow Range("A3"), "$2:$2", Rows("1:1")
ElseIf objDataForm.obWeek Then
PagSetColHeads Range(Range("IV2").End(xlToLeft), "A2"), 2, 5, True
PagSetFreezeRow Range("A3"), "$2:$2", Rows("1:1")
Rows(2).RowHeight = 23.25
lgWeek = Range("1:1").Find(What:="Date", SearchOrder:=xlByRows).Column
Range(Cells(1, lgWeek), (Cells(1, FinalColumn(ActiveSheet)))).EntireColumn.ColumnWidth = 10
End If
Else
If objDataForm.obMonth Or objDataForm.obQuarter Then
PagSetColHeads Range(Range("IV4").End(xlToLeft), "A2"), 2, 5, False
PagSetFreezeRow Range("A5"), "$2:$4", Rows("1:1")
ElseIf objDataForm.obYear Then
PagSetColHeads Range(Range("IV3").End(xlToLeft), "A2"), 2, 5, False
PagSetFreezeRow Range("A4"), "$2:$3", Rows("1:1")
ElseIf objDataForm.obNoDate Then
PagSetColHeads Range(Range("IV2").End(xlToLeft), "A2"), 2, 5, False
PagSetFreezeRow Range("A3"), "$2:$2", Rows("1:1")
ElseIf objDataForm.obWeek Then
PagSetColHeads Range(Range("IV3").End(xlToLeft), "A2"), 2, 5, True
PagSetFreezeRow Range("A4"), "$2:$3", Rows("1:1")
If objDataForm.obTimePeriod Then
Rows(3).RowHeight = 23.25
Else
Rows(2).RowHeight = 23.25
End If
lgWeek = Range("1:1").Find(What:="Date", SearchOrder:=xlByRows).Column
Range(Cells(1, lgWeek), (Cells(1, FinalColumn(ActiveSheet)))).EntireColumn.ColumnWidth = 10
End If
End If
End Sub
Sub EndSalesReport(ByVal objDataForm As Object, ByVal lngDateColumn As Long)

errUpdateLogFile "Sub-" & "EndSalesReport", "objDataForm " & objDataForm.Name
errUpdateLogFile "lngDateColumn", lngDateColumn
pvt.Activate
ptEnd
pagsetPrintHeadingPvt PivotTableOptions, lngDateColumn

ChoosePvtColumnHeading objDataForm
If objDataForm.cbSave Then
ActiveWorkbook.Save
End If
If objDataForm.cbPrint Then
PrintCode
End If

End Sub
Sub TestProductSubtotals()

errUpdateLogFile "Sub-" & "TestProductSubtotals"
If Not PivotTableOptions.obNoSubTotals Then
ptCreateTotals "Product[All;Total]", 15
Else
ptNoTotal "Product"
End If
End Sub



Option Explicit
Sub ptBegin(ByVal ptFinalRow As Long)

Dim pTcache As PivotCache

errUpdateLogFile "Sub-" & "ptBegin", "ptFinalRow " & ptFinalRow

WB(1).Names.Add Name:="pvtData", RefersToR1C1:=workingBook.Cells(1, 1).Resize(ptFinalRow, FinalColumn(workingBook))

workingBook.Activate
Set pTcache = WB(1).PivotCaches.Add(SourceType:=xlDatabase, SourceData:="pvtData")
Set PT = pTcache.CreatePivotTable(TableDestination:=pvt.Range("A1"), TableName:="PivotTable")
PT.ManualUpdate = True
PT.RowGrand = False
PT.PrintTitles = True
PT.NullString = "0"
PT.DisplayErrorString = True
PT.HasAutoFormat = False
PT.PreserveFormatting = True
Set pTcache = Nothing

End Sub
Sub ptSortDate(ByVal objDataForm As Object, ByVal stgGroupBy1 As String, Optional ByVal stgGroupBy2 As String)

errUpdateLogFile "Sub-" & "ptSortDate", "objDataForm " & objDataForm.Name
errUpdateLogFile ",stgGroupBy1", stgGroupBy1
If objDataForm.obDescending Then
PT.PivotFields(stgGroupBy1).AutoSort xlDescending, stgGroupBy1
If Not stgGroupBy2 = "" Then
errUpdateLogFile ",stgGroupBy2", stgGroupBy2
PT.PivotFields(stgGroupBy2).AutoSort xlDescending, stgGroupBy2
End If
Else
PT.PivotFields(stgGroupBy1).AutoSort xlAscending, stgGroupBy1
If Not stgGroupBy2 = "" Then
errUpdateLogFile ",stgGroupBy2", stgGroupBy2
PT.PivotFields(stgGroupBy2).AutoSort xlAscending, stgGroupBy2
End If
End If
End Sub
Sub ptAddGrossProfitCalcField()

errUpdateLogFile "Sub-" & "ptAddGrossProfitCalcField"
PT.CalculatedFields.Add "GPPerc", "=Profit /Amt", True
ptAddDataField "GPPerc", xlAverage, "0.00%;[Red]-0.00%;* ""-"";_(@_)", "GP %"
End Sub
Sub ptAddPriceCalcField()

errUpdateLogFile "Sub-" & "ptAddPriceCalcField"
PT.CalculatedFields.Add "CalcPrice", "=Amt /Units", True
End Sub
Sub ptAddUnitCostCalcField()

errUpdateLogFile "Sub-" & "ptAddUnitCostCalcField"
PT.CalculatedFields.Add "CalcCost", "='Total Cost'/Units", True
End Sub
Sub ptAddSingleData(ByVal objDataForm As Object)

Dim blnShowDollars As Boolean

errUpdateLogFile "Sub-" & "ptAddSingleData", "objDataForm " & objDataForm.Name
blnShowDollars = GetSetting("Business Reporting Today", "General", "Show$", True)
If objDataForm.cbCases Then
ptAddDataField "Cases", xlSum, "* #,##0;[Red]-#,##0;* ""-"";_(@_)", "Qty"
ElseIf objDataForm.cbAmount Then
If blnShowDollars Then
ptAddDataField "Amt", xlSum, "$#,##0;[Red]$-#,##0;* ""-"";_(@_)", "Sls$$"
Else
ptAddDataField "Amt", xlSum, "#,##0;[Red]-#,##0;* ""-"";_(@_)", "Sls$$"
End If
ElseIf objDataForm.cbProfit Then
If blnShowDollars Then
ptAddDataField "Profit", xlSum, "$#,##0;[Red]&-#,##0;* ""-"";_(@_)", "GP$$"
Else
ptAddDataField "Profit", xlSum, "#,##0;[Red]-#,##0;* ""-"";_(@_)", "GP$$"
End If
ElseIf objDataForm.cbProfitPerc Then
ptAddGrossProfitCalcField
ElseIf objDataForm.cbUnits Then
ptAddDataField "Units", xlSum, "#,##0;[Red]-#,##0;* ""-"";_(@_)", "Unit"
ElseIf objDataForm.cbCost Then
If blnShowDollars Then
ptAddDataField "Total Cost", xlSum, "$#,##0;$-#,##0;* ""-"";_(@_)", "Ttl Cost"
Else
ptAddDataField "Total Cost", xlSum, "#,##0;-#,##0;* ""-"";_(@_)", "Ttl Cost"
End If
ElseIf objDataForm.cbUnitCost Then
ptAddUnitCostCalcField
If blnShowDollars Then
ptAddDataField "CalcCost", xlAverage, "$#,##0.00;$-#,##0.00;* ""-"";_(@_)", "Unt Cost"
Else
ptAddDataField "CalcCost", xlAverage, "#,##0.00;-#,##0.00;* ""-"";_(@_)", "Unt Cost"
End If
ElseIf objDataForm.cbPrice Then
ptAddPriceCalcField
If blnShowDollars Then
ptAddDataField "CalcPrice", xlAverage, "$#,##0.00;*$#,##0.00;* ""-"";_(@_)", "Price"
Else
ptAddDataField "CalcPrice", xlAverage, "#,##0.00;*#,##0.00;* ""-"";_(@_)", "Price"
End If
ElseIf objDataForm.cbWeight Then
ptAddDataField "Weight", xlSum, "* #,##0;[Red]-#,##0;* ""-"";_(@_)", "lbs."
End If
End Sub
Sub ptAddDataTest(ByVal objDataForm As Object)
Dim blnShowDollars As Boolean

errUpdateLogFile "Sub-" & "ptAddDataTest", "objDataForm " & objDataForm.Name
blnShowDollars = GetSetting("Business Reporting Today", "General", "Show$", True)

SaveSetting "Business Reporting Today", "Debug", "End", "ptAddDataTest"
If objDataForm.cbCases Then
ptAddDataField "Cases", xlSum, "* #,##0;[Red]-#,##0;* ""-"";_(@_)", "Qty"
End If
If objDataForm.cbAmount Then
If blnShowDollars Then
ptAddDataField "Amt", xlSum, "$#,##0;[Red]$-#,##0;* ""-"";_(@_)", "Sls$$"
Else
ptAddDataField "Amt", xlSum, "#,##0;[Red]-#,##0;* ""-"";_(@_)", "Sls$$"
End If
End If
If objDataForm.cbProfit Then
If blnShowDollars Then
ptAddDataField "Profit", xlSum, "$#,##0;[Red]$-#,##0;* ""-"";_(@_)", "GP$$"
Else
ptAddDataField "Profit", xlSum, "#,##0;[Red]-#,##0;* ""-"";_(@_)", "GP$$"
End If
End If
If objDataForm.cbProfitPerc Then
ptAddGrossProfitCalcField
End If
If objDataForm.cbUnits Then
ptAddDataField "Units", xlSum, "#,##0;[Red]-#,##0;* ""-"";_(@_)", "Unit"
End If
If objDataForm.cbCost Then
If blnShowDollars Then
ptAddDataField "Total Cost", xlSum, "$#,##0;$-#,##0;* ""-"";_(@_)", "Ttl Cost"
Else
ptAddDataField "Total Cost", xlSum, "#,##0;-#,##0;* ""-"";_(@_)", "Ttl Cost"
End If
End If
If objDataForm.cbUnitCost Then
ptAddUnitCostCalcField
If blnShowDollars Then
ptAddDataField "CalcCost", xlAverage, "$#,##0.00;$-#,##0.00;* ""-"";_(@_)", "Unt Cost"
Else
ptAddDataField "CalcCost", xlAverage, "#,##0.00;-#,##0.00;* ""-"";_(@_)", "Unt Cost"
End If
End If
If objDataForm.cbPrice Then
ptAddPriceCalcField
If blnShowDollars Then
ptAddDataField "CalcPrice", xlAverage, "$#,##0.00;*$#,##0.00;* ""-"";_(@_)", "Price"
Else
ptAddDataField "CalcPrice", xlAverage, "#,##0.00;*#,##0.00;* ""-"";_(@_)", "Price"
End If
End If
On Error Resume Next
If objDataForm.cbWeight Then
ptAddDataField "Weight", xlSum, "* #,##0;[Red]-#,##0;* ""-"";_(@_)", "lbs."
End If
SaveSetting "Business Reporting Today", "Debug", "ptAddDataTest", "OK"

End Sub
Sub ptAddRowField(ByVal stgRowField As String, Optional ByVal stgRowField2 As String)

errUpdateLogFile "Sub-" & "ptAddRowField"
errUpdateLogFile ",stgRowField", stgRowField
PT.AddFields RowFields:=Array(stgRowField), AddToTable:=True
PT.PivotFields(stgRowField).AutoSort xlAscending, stgRowField
If stgRowField = "Item#" Or stgRowField = "Cust#" Then
ptNoTotal stgRowField
End If
If Not stgRowField2 = "" Then
errUpdateLogFile "stgRowField2", stgRowField2
PT.AddFields RowFields:=Array(stgRowField2), AddToTable:=True
PT.PivotFields(stgRowField2).AutoSort xlAscending, stgRowField2
If stgRowField2 = "Item#" Or stgRowField2 = "Cust#" Then
ptNoTotal stgRowField2
End If
End If
End Sub
Sub ptAddColField(ByVal stgColField As String)

errUpdateLogFile "Sub-" & "ptAddColField", stgColField
PT.AddFields , ColumnFields:=stgColField, AddToTable:=True
End Sub
Sub ptAddDataField(ByRef stgDataField As String, _
ByRef stgFunction As Long, ByRef stgNumFormat As String, Optional ByRef stgName As String)

errUpdateLogFile "Sub-" & "ptAddDataField", stgDataField
errUpdateLogFile ",ptAddDataField"
errUpdateLogFile ",stgFunction", stgFunction
errUpdateLogFile ",stgNumFormat", stgNumFormat
With PT.PivotFields(stgDataField)
.Orientation = xlDataField
.Function = stgFunction
.NumberFormat = stgNumFormat
If Not stgName = "" Then
errUpdateLogFile "stgName", stgName
.Name = stgName
End If
End With

End Sub
Sub ptColField(ByVal stgPosition As String)

errUpdateLogFile "Sub-" & "ptColField", "Position" & stgPosition
With PT.DataPivotField
.Orientation = xlColumnField
.Position = stgPosition
End With
End Sub
Sub ptYearPosition(ByVal stgPosition As String)

errUpdateLogFile "Sub-" & "ptYearPosition", "Position" & stgPosition
With PT.PivotFields("Years")
.Orientation = xlColumnField
.Position = stgPosition
End With

End Sub
Sub byWeek()

Dim firstDate As Date, whichDay As Date, startDate As Date
Dim pf As PivotField

errUpdateLogFile "Sub-" & "byWeek"
Set pf = PT.PivotFields("Date")
firstDate = PT.PivotFields("Date").LabelRange.Offset(1, 0).Value
whichDay = Application.WorksheetFunction.Weekday(firstDate, 2)
startDate = firstDate - whichDay
PT.PivotFields("Date").LabelRange.Group Start:=startDate, End:=True, By:=7, _
Periods:=Array(False, False, False, True, False, False, False)

End Sub
Sub ptDateGroup(ByVal blnMonth As Boolean, ByVal blnQuarter As Boolean, ByVal blnYear As Boolean)

Dim pf As PivotField

errUpdateLogFile "Sub-" & "ptDateGroup"
errUpdateLogFile ",blnMonth", blnMonth
errUpdateLogFile ",blnQuarter", blnQuarter
errUpdateLogFile ",blnYear", blnYear
Set pf = PT.PivotFields("Date")

pf.LabelRange.Group Start:=True, End:=True, Periods:=Array(False, False, False _
, False, blnMonth, blnQuarter, blnYear)
End Sub
Sub ptNoTotal(ByVal stgRowField As String)

errUpdateLogFile "Sub-" & "ptNoTotal", stgRowField
PT.PivotFields(stgRowField).subtotals = Array(False, False, False, False, False, False, _
False, False, False, False, False, False)
End Sub
Sub ptCreateTotals(ByVal stgName As String, ByVal lngClr As Long)

On Error GoTo errorhandler
errUpdateLogFile "Sub-" & "ptCreateTotals", stgName
errUpdateLogFile ",lngClr", lngClr
pvt.Activate
PT.PivotSelect stgName, xlDataAndLabel, True
Selection.Interior.ColorIndex = lngClr
Selection.Font.Bold = True
Exit Sub

errorhandler:
Error00_00_00code

End Sub
Sub ptRepGenTotals(ByVal objDataForm As Object)

errUpdateLogFile "Sub-" & "ptRepGenTotals", "objDataForm " & objDataForm.Name
On Error Resume Next
If j = 1 And Not objDataForm.obNoItemNum Then
If Not objDataForm.obNoSubTotals Then
ptCreateTotals Total1, 15
Exit Sub
Else
ptNoTotal "Product"
Exit Sub
End If
Exit Sub
ElseIf j = 2 Then
ptCreateTotals Total1, 15
ElseIf j = 3 Then
ptCreateTotals Total1, 15
ptCreateTotals Total2, 37
ElseIf j = 4 Then
ptCreateTotals Total1, 15
ptCreateTotals Total2, 37
ptCreateTotals Total3, 38
ElseIf j = 5 Then
ptCreateTotals Total1, 15
ptCreateTotals Total2, 37
ptCreateTotals Total3, 38
ptCreateTotals Total4, 35
End If

End Sub
Sub ptEnd()

errUpdateLogFile "Sub-" & "ptEnd"
PT.ManualUpdate = False
'Highlight Grand Total
PT.PivotSelect "'Column Grand Total'", xlDataAndLabel, True
Selection.Font.ColorIndex = 2
Selection.Interior.ColorIndex = 5
Selection.Font.Bold = True

Set PT = Nothing
End Sub
Sub ptChooseCol1orCol2(ByVal objDataForm As Object)

errUpdateLogFile "Sub-" & "ptChooseCol1orCol2", "objDataForm " & objDataForm.Name
If objDataForm.obData Then
ptColField 2
Else
ptColField 1
End If

End Sub
Sub ptChooseCol1_2orCol3_1(ByVal objDataForm As Object)

errUpdateLogFile "Sub-" & "ptChooseCol1_2orCol3_1", "objDataForm " & objDataForm.Name
If objDataForm.obData Then
ptColField 1
ptYearPosition 2
Else
ptColField 3
ptYearPosition 1
End If

End Sub
Sub ptReportOptions(ByVal objDataForm As Object)

'With Worksheets("detail")
' sFormula = "SUMPRODUCT(--(YEAR(detail!B2:B" & .Cells(.Rows.Count, 2).End(xlUp).Row & _
' ")=YEAR(B2)))=COUNT(detail!B2:B" & .Cells(.Rows.Count, 2).End(xlUp).Row & ")"
'End With
errUpdateLogFile "Sub-" & "ptReportOptions", "objDataForm " & objDataForm.Name
If Not objDataForm.obNoDate Then
ptAddColField "Date"
End If
If i = 1 And Not objDataForm.cbShowChange Then
ptAddSingleData objDataForm

PT.ManualUpdate = False

If objDataForm.obMonth Then
ptDateGroup True, False, True
ptSortDate objDataForm, "Years", "Date"
ElseIf objDataForm.obYear Then
ptDateGroup False, False, True
ptSortDate objDataForm, "Date"
ElseIf objDataForm.obQuarter Then
ptDateGroup False, True, True
ptSortDate objDataForm, "Years", "Date"
ElseIf objDataForm.obWeek Then
byWeek
ptSortDate objDataForm, "Date"
End If
Else
PT.AddFields , ColumnFields:=Array("Data"), AddToTable:=True
ptAddDataTest objDataForm
PT.ManualUpdate = False

If objDataForm.obMonth Then
ptDateGroup True, False, True
If objDataForm.cbShowChange Then
ptAddPercChange objDataForm
End If
ptChooseCol1_2orCol3_1 objDataForm
ptNoTotal "Date"
ptSortDate objDataForm, "Years", "Date"
ElseIf objDataForm.obQuarter Then
ptDateGroup False, True, True
If objDataForm.cbShowChange Then
ptAddPercChange objDataForm
End If
ptChooseCol1_2orCol3_1 objDataForm
ptNoTotal "Date"
ptSortDate objDataForm, "Years", "Date"
ElseIf objDataForm.obYear Then
ptDateGroup False, False, True
If objDataForm.cbShowChange Then
ptAddPercChange objDataForm
End If
ptChooseCol1orCol2 objDataForm
ptSortDate objDataForm, "Date"
ElseIf objDataForm.obWeek Then
byWeek
If objDataForm.cbShowChange Then
ptAddPercChange objDataForm
End If
ptChooseCol1orCol2 objDataForm
ptSortDate objDataForm, "Date"
End If
End If

End Sub
Sub ptAddPercDiff(ByVal objDataForm As Object, ByVal stgField As String, ByVal stgName As String)

errUpdateLogFile "Sub-" & "ptAddPercDiff", "objDataForm " & objDataForm.Name
errUpdateLogFile ",stgField", stgField
errUpdateLogFile ",stgName", stgName
If objDataForm.obDescending Then
With PT.PivotFields(stgField)
.Orientation = xlDataField
.Function = xlSum
.Name = stgName & " % Change"
.Calculation = xlPercentDifferenceFrom
.BaseField = "Date"
.BaseItem = "(next)"
.NumberFormat = "0.00%"
End With
Else
With PT.PivotFields(stgField)
.Orientation = xlDataField
.Function = xlSum
.Name = stgName & " % Change"
.Calculation = xlPercentDifferenceFrom
.BaseField = "Date"
.BaseItem = "(previous)"
.NumberFormat = "0.00%"
End With
End If
End Sub
Sub ptAddPercChange(ByVal objDataForm As Object)

errUpdateLogFile "Sub-" & "ptAddPercChange", "objDataForm " & objDataForm.Name
If objDataForm.cbCases Then
ptAddPercDiff objDataForm, "Cases", "Qty"
End If
If objDataForm.cbAmount Then
ptAddPercDiff objDataForm, "Amt", "Sls$$"
End If
If objDataForm.cbProfit Then
ptAddPercDiff objDataForm, "Profit", "GP$$"
End If
If objDataForm.cbProfitPerc Then
ptAddPercDiff objDataForm, "GPPerc", "GP %"
End If
If objDataForm.cbUnits Then
ptAddPercDiff objDataForm, "Units", "Unit"
End If
If objDataForm.cbCost Then
ptAddPercDiff objDataForm, "Total Cost", "Ttl Cost"
End If
If objDataForm.cbUnitCost Then
ptAddPercDiff objDataForm, "CalcCost", "Unt Cost"
End If
If objDataForm.cbPrice Then
ptAddPercDiff objDataForm, "CalcPrice", "Price"
End If

End Sub
Sub ptAddProduct(ByVal objDataForm As Object)

errUpdateLogFile "Sub-" & "ptAddProduct", "objDataForm " & objDataForm.Name
If objDataForm.obNoItemNum Then
ptAddRowField "Product"
ElseIf objDataForm.obSortByProduct Then
ptAddRowField "Product", "Item#"
ElseIf objDataForm.obSortByItem Then
ptAddRowField "Item#", "Product"
End If
End Sub
Sub ptChooseProdRow2(ByVal stgrField1 As String, ByVal stgrField2 As String)

errUpdateLogFile "Sub-" & "ptChooseProdRow2"
errUpdateLogFile ",stgrField1", stgrField1
errUpdateLogFile ",stgrField2", stgrField2
If PivotTableOptions.obNoItemNum Then
ptAddRowField stgrField1
ElseIf PivotTableOptions.obSortByProduct Then
ptAddRowField stgrField1, stgrField2
ElseIf PivotTableOptions.obSortByItem Then
ptAddRowField stgrField2, stgrField1
End If

End Sub
Sub ptChooseProdRow3(ByVal stgField1 As String, ByVal stgField2 As String, ByVal stgField3 As String)

errUpdateLogFile "Sub-" & "ptChooseProdRow3"
errUpdateLogFile ",stgrField1", stgField1
errUpdateLogFile ",stgrField2", stgField2
errUpdateLogFile ",stgrField3", stgField3
If stgField1 = "Product" Then
If PivotTableOptions.obNoItemNum Then
ptAddRowField stgField1
ElseIf PivotTableOptions.obSortByProduct Then
ptAddRowField stgField1, stgField2
ElseIf PivotTableOptions.obSortByItem Then
ptAddRowField stgField2, stgField1
End If
ptAddRowField stgField3
ElseIf stgField2 = "Product" Then
ptAddRowField stgField1
If PivotTableOptions.obNoItemNum Then
ptAddRowField stgField2
ElseIf PivotTableOptions.obSortByProduct Then
ptAddRowField stgField2, stgField3
ElseIf PivotTableOptions.obSortByItem Then
ptAddRowField stgField3, stgField2
End If
End If
End Sub
Sub ptChooseProdRow4(ByVal stgField1 As String, ByVal stgField2 As String, _
ByVal stgField3 As String, ByVal stgField4 As String)

errUpdateLogFile "Sub-" & "ptChooseProdRow4"
errUpdateLogFile ",stgrField1", stgField1
errUpdateLogFile ",stgrField2", stgField2
errUpdateLogFile ",stgrField3", stgField3
errUpdateLogFile ",stgrField4", stgField4
If stgField1 = "Product" Then
If PivotTableOptions.obNoItemNum Then
ptAddRowField stgField1
ElseIf PivotTableOptions.obSortByProduct Then
ptAddRowField stgField1, stgField2
ElseIf PivotTableOptions.obSortByItem Then
ptAddRowField stgField2, stgField1
End If
ptAddRowField stgField3, stgField4
ElseIf stgField2 = "Product" Then
ptAddRowField stgField1
If PivotTableOptions.obNoItemNum Then
ptAddRowField stgField2
ElseIf PivotTableOptions.obSortByProduct Then
ptAddRowField stgField2, stgField3
ElseIf PivotTableOptions.obSortByItem Then
ptAddRowField stgField3, stgField2
End If
ptAddRowField stgField4
ElseIf stgField3 = "Product" Then
ptAddRowField stgField1, stgField2
If PivotTableOptions.obNoItemNum Then
ptAddRowField stgField3
ElseIf PivotTableOptions.obSortByProduct Then
ptAddRowField stgField3, stgField4
ElseIf PivotTableOptions.obSortByItem Then
ptAddRowField stgField4, stgField3
End If
End If

End Sub
Sub ptChooseProdRow5(ByVal stgField1 As String, ByVal stgField2 As String, _
ByVal stgField3 As String, ByVal stgField4 As String, ByVal stgField5 As String)

errUpdateLogFile "Sub-" & "ptChooseProdRow5"
errUpdateLogFile ",stgrField1", stgField1
errUpdateLogFile ",stgrField2", stgField2
errUpdateLogFile ",stgrField3", stgField3
errUpdateLogFile ",stgrField4", stgField4
errUpdateLogFile ",stgrField5", stgField5
If stgField1 = "Product" Then
If PivotTableOptions.obNoItemNum Then
ptAddRowField stgField1
ElseIf PivotTableOptions.obSortByProduct Then
ptAddRowField stgField1, stgField2
ElseIf PivotTableOptions.obSortByItem Then
ptAddRowField stgField2, stgField1
End If
ptAddRowField stgField3, stgField4
ptAddRowField stgField5
ElseIf stgField2 = "Product" Then
ptAddRowField stgField1
If PivotTableOptions.obNoItemNum Then
ptAddRowField stgField2
ElseIf PivotTableOptions.obSortByProduct Then
ptAddRowField stgField2, stgField3
ElseIf PivotTableOptions.obSortByItem Then
ptAddRowField stgField3, stgField2
End If
ptAddRowField stgField4, stgField5
ElseIf stgField3 = "Product" Then
ptAddRowField stgField1, stgField2
If PivotTableOptions.obNoItemNum Then
ptAddRowField stgField3
ElseIf PivotTableOptions.obSortByProduct Then
ptAddRowField stgField3, stgField4
ElseIf PivotTableOptions.obSortByItem Then
ptAddRowField stgField4, stgField3
End If
ptAddRowField stgField5
ElseIf stgField4 = "Product" Then
ptAddRowField stgField1, stgField2
ptAddRowField stgField3
If PivotTableOptions.obNoItemNum Then
ptAddRowField stgField4
ElseIf PivotTableOptions.obSortByProduct Then
ptAddRowField stgField4, stgField5
ElseIf PivotTableOptions.obSortByItem Then
ptAddRowField stgField5, stgField4
End If
End If

End Sub

Djblois
07-17-2007, 09:06 AM
I forgot to add, I know I still need to get better with comments, that is one of my next goals. My add-in is used as reporting software at my company. The portion I posted is the sales Detail code, (However, a lot of it is reused for other reports as well)

Norie
07-17-2007, 09:17 AM
Still seems to be a lot of repetition, especially in the 1st set of code.

PS I counted 50 subs in that.:bug:

Djblois
07-17-2007, 09:21 AM
I agree but I don't know how to cut the subs down. I cut the length of the subs down. Each one of those subs is a different report that a user chooses by clicking a button.

Each of those subs have to pass different variables based on the user input and button clicked. All those subs are doing is calling other subs with the code that I am reusing with the variables needed for that report.

Djblois
07-17-2007, 09:33 AM
Here to make it a lil more logical I will lay out the code that runs for of the reports in Order:

Sub CustSales()

comFormName PivotTableOptions, "Customer-SalesPerson", "Cust-Sales", SalesReports 'Open form and populate form Caption and textbox
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "Customer", "Cust#" 'Adds Pivot Table Fields
ptAddRowField "SlsPrsn" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions 'Get options from userform
ptCreateTotals "Customer[All;Total]", 15
EndSalesReport PivotTableOptions, 2
End Sub
Sub comFormName(ByVal objDataForm As Object, ByVal stgCaption As String, ByVal stgReportName As String, _
Optional ByVal objDataForm2 As Object)

errUpdateLogFile "Sub-" & "comFormName", objDataForm.Name
errUpdateLogFile ",stgCaption", stgCaption
errUpdateLogFile ",stgReportName", stgReportName
If Not objDataForm2 Is Nothing Then
errUpdateLogFile ",objDataForm2", objDataForm2.Name
Unload objDataForm2
DoEvents
End If

objDataForm.Caption = stgCaption
objDataForm.ReportName.Value = stgReportName
End Sub
Sub StartSalesReport(ByVal lngPivotData As Long, Optional ByVal objUserForm As Object, _
Optional ByVal stgReportName As String)
CreateTab:

If Not objUserForm Is Nothing Then
errUpdateLogFile "StartSalesReport", "objUserForm " & objUserForm.Name
Else
errUpdateLogFile "StartSalesReport"
End If
errUpdateLogFile ",lngPivotData", lngPivotData
If Not stgReportName = "" Then
errUpdateLogFile ",stgReportname", stgReportName
End If

If Not objUserForm Is Nothing Then
objUserForm.Show
Set firstUserForm = objUserForm
End If

If stgReportName = "" Then
myInput = firstUserForm.ReportName
Else
myInput = stgReportName
End If

'Test if user left name blank
If (myInput) = "" Then
If Not objUserForm Is Nothing Then
firstUserForm.Hide
DoEvents
End If
Error00_00_03.Show
Exit Sub
End If

'Test if another sheet with the same name exists
If SheetExists(myInput) Then
If Not objUserForm Is Nothing Then
firstUserForm.Hide
DoEvents
End If
Error00_00_02.Show
Exit Sub
End If
'Test if user selected at least one data value
If Not objUserForm Is Nothing Then
If i = 0 Then
MsgBox "You need to select at least one value to view!"
GoTo CreateTab
End If
End If

TurnOffFeatures
Set pvt = Worksheets.Add(, workingBook, 1)
pvt.Name = myInput
ptBegin lngPivotData
Exit Sub

errorhandler:
Error00_00_00code

End Sub
Sub ptBegin(ByVal ptFinalRow As Long)

Dim pTcache As PivotCache

errUpdateLogFile "Sub-" & "ptBegin", "ptFinalRow " & ptFinalRow

WB(1).Names.Add Name:="pvtData", RefersToR1C1:=workingBook.Cells(1, 1).Resize(ptFinalRow, FinalColumn(workingBook))

workingBook.Activate
Set pTcache = WB(1).PivotCaches.Add(SourceType:=xlDatabase, SourceData:="pvtData")
Set PT = pTcache.CreatePivotTable(TableDestination:=pvt.Range("A1"), TableName:="PivotTable")
PT.ManualUpdate = True
PT.RowGrand = False
PT.PrintTitles = True
PT.NullString = "0"
PT.DisplayErrorString = True
PT.HasAutoFormat = False
PT.PreserveFormatting = True
Set pTcache = Nothing

End Sub
Sub ptAddRowField(ByVal stgRowField As String, Optional ByVal stgRowField2 As String)

errUpdateLogFile "Sub-" & "ptAddRowField"
errUpdateLogFile ",stgRowField", stgRowField
PT.AddFields RowFields:=Array(stgRowField), AddToTable:=True
PT.PivotFields(stgRowField).AutoSort xlAscending, stgRowField
If stgRowField = "Item#" Or stgRowField = "Cust#" Then
ptNoTotal stgRowField
End If
If Not stgRowField2 = "" Then
errUpdateLogFile "stgRowField2", stgRowField2
PT.AddFields RowFields:=Array(stgRowField2), AddToTable:=True
PT.PivotFields(stgRowField2).AutoSort xlAscending, stgRowField2
If stgRowField2 = "Item#" Or stgRowField2 = "Cust#" Then
ptNoTotal stgRowField2
End If
End If
End Sub
Sub ptReportOptions(ByVal objDataForm As Object)

'With Worksheets("detail")
' sFormula = "SUMPRODUCT(--(YEAR(detail!B2:B" & .Cells(.Rows.Count, 2).End(xlUp).Row & _
' ")=YEAR(B2)))=COUNT(detail!B2:B" & .Cells(.Rows.Count, 2).End(xlUp).Row & ")"
'End With
errUpdateLogFile "Sub-" & "ptReportOptions", "objDataForm " & objDataForm.Name
If Not objDataForm.obNoDate Then
ptAddColField "Date"
End If
If i = 1 And Not objDataForm.cbShowChange Then
ptAddSingleData objDataForm

PT.ManualUpdate = False

If objDataForm.obMonth Then
ptDateGroup True, False, True
ptSortDate objDataForm, "Years", "Date"
ElseIf objDataForm.obYear Then
ptDateGroup False, False, True
ptSortDate objDataForm, "Date"
ElseIf objDataForm.obQuarter Then
ptDateGroup False, True, True
ptSortDate objDataForm, "Years", "Date"
ElseIf objDataForm.obWeek Then
byWeek
ptSortDate objDataForm, "Date"
End If
Else
PT.AddFields , ColumnFields:=Array("Data"), AddToTable:=True
ptAddDataTest objDataForm
PT.ManualUpdate = False

If objDataForm.obMonth Then
ptDateGroup True, False, True
If objDataForm.cbShowChange Then
ptAddPercChange objDataForm
End If
ptChooseCol1_2orCol3_1 objDataForm
ptNoTotal "Date"
ptSortDate objDataForm, "Years", "Date"
ElseIf objDataForm.obQuarter Then
ptDateGroup False, True, True
If objDataForm.cbShowChange Then
ptAddPercChange objDataForm
End If
ptChooseCol1_2orCol3_1 objDataForm
ptNoTotal "Date"
ptSortDate objDataForm, "Years", "Date"
ElseIf objDataForm.obYear Then
ptDateGroup False, False, True
If objDataForm.cbShowChange Then
ptAddPercChange objDataForm
End If
ptChooseCol1orCol2 objDataForm
ptSortDate objDataForm, "Date"
ElseIf objDataForm.obWeek Then
byWeek
If objDataForm.cbShowChange Then
ptAddPercChange objDataForm
End If
ptChooseCol1orCol2 objDataForm
ptSortDate objDataForm, "Date"
End If
End If

End Sub
Sub ptCreateTotals(ByVal stgName As String, ByVal lngClr As Long)

On Error GoTo errorhandler
errUpdateLogFile "Sub-" & "ptCreateTotals", stgName
errUpdateLogFile ",lngClr", lngClr
pvt.Activate
PT.PivotSelect stgName, xlDataAndLabel, True
Selection.Interior.ColorIndex = lngClr
Selection.Font.Bold = True
Exit Sub

errorhandler:
Error00_00_00code

End Sub
Sub EndSalesReport(ByVal objDataForm As Object, ByVal lngDateColumn As Long)

errUpdateLogFile "Sub-" & "EndSalesReport", "objDataForm " & objDataForm.Name
errUpdateLogFile "lngDateColumn", lngDateColumn
pvt.Activate
ptEnd
pagsetPrintHeadingPvt PivotTableOptions, lngDateColumn

ChoosePvtColumnHeading objDataForm
If objDataForm.cbSave Then
ActiveWorkbook.Save
End If
If objDataForm.cbPrint Then
PrintCode
End If

End Sub


That is the logical progression of one of the reports and this is how the user gets the report:

1. they press the button Cust/ Slsprsn
2. they chose the options that they want in the next form

Djblois
07-19-2007, 07:17 AM
Norie,

Do you have any idea How I can reduce the code anymore?

rory
07-19-2007, 08:25 AM
Hi,
If you look at these routines:
Sub WareSales()

comFormName PivotTableOptions, "WareHouse-SalesPerson", "Whse-Sales", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "Whse", "SlsPrsn" 'Adds Pivot Table Fields
ptReportOptions PivotTableOptions
ptCreateTotals "Whse[All;Total]", 15
EndSalesReport PivotTableOptions, 2
End Sub
Sub WareSalesCust()

comFormName PivotTableOptions, "WareHouse-SalesPerson-Customer", "Whse-Sales-Cust", SalesReports
StartSalesReport FinalRow(workingBook) - 1, PivotTableOptions
ptAddRowField "Whse", "SlsPrsn" 'Adds Pivot Table Fields
ptAddRowField "Customer", "Cust#" 'Adds Pivot Table Fields
ptNoTotal "Customer"
ptReportOptions PivotTableOptions
WareSalesTotals
EndSalesReport PivotTableOptions, 2
End Sub
Sub WareSalesTotals()

'Highlight Cust Totals
ptCreateTotals "Whse[All;Total]", 15
ptCreateTotals "SlsPrsn[All;Total]", 37
End Sub


You will notice that they are very similar - the second and third subs just extend the first a bit. It should be possible to rewrite this as one sub that takes a couple of arguments to determine whether to do the additional work. (In fact, I suspect you should be able to have a few much more generic routines to build the pivot table based on specific arguments passed to them). Without seeing the whole add-in it's hard to be specific, but there seems to be too close a link between the userform and the routines it calls, which makes me think that the design could be improved. However, if it's working for you, that is the main thing!
One other small thing, in addition to the lack of comments, is that you have a few hard-coded strings in the code that should probably be replaced by constants: number formatting codes for example; if you wanted to change these, you would currently have to make the changes a lot of times.
Just my 2 cents.
Regards,
Rory