Djblois
02-01-2007, 12:37 PM
Here I will post all the code but it is too much for you to go through. Most of it is not relavant:
Form 1
Private Sub CommandButton125_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
detail.Activate
ShowColumns.Show
End Sub
Private Sub CommandButton126_Click()
'
SalesReports.Hide
End
End Sub
Private Sub CommandButton127_Click()
'
Set sb = New clsProgressBar
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
InputName:
NameReport.Caption = "Invoice by Date"
NameReport.ReportName.Value = "Invoice by Date"
NameReport.Show
Err.Clear
myInput = NameReport.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!"
NameReport.ReportName.Value = ""
GoTo InputName
End If
Set pvt = Worksheets.Add(, detail, 1)
pvt.Name = myInput
For Each pt In pvt.PivotTables
pt.TableRange1.Clear
pt.TableRange2.Clear
Next pt
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
FirstProgress
InvoiceDate
SecondProgress
PrintHeadingPvt
ThirdProgress
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & NameReport.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton130_Click()
'
sortrows
End Sub
Private Sub CommandButton132_Click()
'
Set sb = New clsProgressBar
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PFGoptions.ReportName.Value = "Compare Customers"
PFGoptions.Caption = "Compare Customers"
PFGShipto
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PFGoptions.RightHeader.Value
End Sub
Private Sub CommandButton134_Click()
'
Set sb = New clsProgressBar
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
InputName:
NameReport.Caption = "Invoice Detail"
NameReport.ReportName.Value = "Invoice Detail"
NameReport.Show
Err.Clear
myInput = NameReport.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!"
NameReport.ReportName.Value = ""
GoTo InputName
End If
Set pvt = Worksheets.Add(, detail, 1)
pvt.Name = myInput
For Each pt In pvt.PivotTables
pt.TableRange1.Clear
pt.TableRange2.Clear
Next pt
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
FirstProgress
InvoiceProduct
SecondProgress
PrintHeadingPvt
ThirdProgress
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & NameReport.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton135_Click()
'
Set sb = New clsProgressBar
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
InputName:
NameReport.Caption = "Invoice Summary"
NameReport.ReportName.Value = "Invoice Summary"
NameReport.Show
Err.Clear
myInput = NameReport.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!"
NameReport.ReportName.Value = ""
GoTo InputName
End If
Set pvt = Worksheets.Add(, detail, 1)
pvt.Name = myInput
For Each pt In pvt.PivotTables
pt.TableRange1.Clear
pt.TableRange2.Clear
Next pt
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
FirstProgress
InvoiceSummary
SecondProgress
PrintHeadingPvt
ThirdProgress
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & NameReport.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton138_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Product-WareHouse"
PivotTableOptions.ReportName.Value = "Product-WareHouse"
AddCode
StartPivot
ProdWare
SalesReportOptions
ProdTotals
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton139_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Customer-SalesPerson"
StartPivot
CustSales
SalesReportOptions
CustTotals
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton140_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Customer-WareHouse"
PivotTableOptions.ReportName.Value = "Customer-WareHouse"
StartPivot
CustWare
SalesReportOptions
CustTotals
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton141_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Product-SalesPerson-Customer"
PivotTableOptions.ReportName.Value = "Product-SalesPerson-Customer"
AddCode
StartPivot
ProdSalesCust
SalesReportOptions
ProdTotals
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton142_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "SalesPerson-Customer"
PivotTableOptions.ReportName.Value = "SalesPerson-Customer"
StartPivot
SalesCust
SalesReportOptions
SalesTotals
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton143_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "WareHouse-Customer"
PivotTableOptions.ReportName.Value = "WareHouse-Customer"
StartPivot
WareCust
SalesReportOptions
WareTotals
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton144_Click()
'
productsub = 0
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Customer-Product-SalesPerson"
PivotTableOptions.ReportName.Value = "Customer-Product-SalesPerson"
AddCode
StartPivot
CustProdSales
SalesReportOptions
CustProdTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton145_Click()
'
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
End Sub
Private Sub CommandButton146_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Customer-WareHouse-SalesPerson"
PivotTableOptions.ReportName.Value = "Customer-WareHouse-SalesPerson"
StartPivot
CustWareSales
SalesReportOptions
CustWareTotals
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton147_Click()
'
productsub = 0
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Product-Customer-SalesPerson"
PivotTableOptions.ReportName.Value = "Product-Customer-SalesPerson"
AddCode
StartPivot
ProdCustSales
SalesReportOptions
ProdCustTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton148_Click()
'
productsub = 0
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Product-Customer-WareHouse"
PivotTableOptions.ReportName.Value = "Product-Customer-WareHouse"
AddCode
StartPivot
ProdCustWare
SalesReportOptions
ProdCustTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton149_Click()
'
productsub = 0
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Product-SalesPerson-WareHouse"
PivotTableOptions.ReportName.Value = "Product-SalesPerson-WareHouse"
AddCode
StartPivot
ProdSalesWare
SalesReportOptions
ProdSalesTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton150_Click()
productsub = 0
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Product-WareHouse-SalesPerson"
PivotTableOptions.ReportName.Value = "Product-WareHouse-SalesPerson"
AddCode
StartPivot
ProdWareSales
SalesReportOptions
ProdWareTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton151_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "SalesPerson-Customer-WareHouse"
StartPivot
SalesCustWare
SalesReportOptions
SalesCustTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton152_Click()
'
productsub = 0
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "SalesPerson-Product-WareHouse"
PivotTableOptions.ReportName.Value = "SalesPerson-Product-WareHouse"
AddCode
StartPivot
SalesProdWare
SalesReportOptions
SalesProdTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton153_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "WareHouse-Customer-SalesPerson"
PivotTableOptions.ReportName.Value = "WareHouse-Customer-SalesPerson"
StartPivot
WareCustSales
SalesReportOptions
WareCustTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton154_Click()
'
productsub = 0
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "WareHouse-Product-SalesPerson"
PivotTableOptions.ReportName.Value = "WareHouse-Product-SalesPerson"
AddCode
StartPivot
WareProdSales
SalesReportOptions
WareProdTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton155_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Set sb = New clsProgressBar
Application.ScreenUpdating = False
OrderSheetOptions.Show
End Sub
Private Sub CommandButton156_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
about.Show
End Sub
Private Sub CommandButton157_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
Active.Activate
DoEvents
Application.ScreenUpdating = False
Email.Show
End Sub
Private Sub CommandButton158_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "SalesPerson"
StartPivot
SalesPerson
SalesReportOptions
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton159_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "WareHouse"
PivotTableOptions.ReportName.Value = "WareHouse"
StartPivot
WareHouse
SalesReportOptions
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton160_Click()
Set sb = New clsProgressBar
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
InputName:
NameReport.Caption = "Credit Report"
NameReport.ReportName.Value = "Credit Report"
NameReport.Show
Err.Clear
myInput = NameReport.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!"
NameReport.ReportName.Value = ""
GoTo InputName
End If
Set pvt = Worksheets.Add(, detail, 1)
pvt.Name = myInput
For Each pt In pvt.PivotTables
pt.TableRange1.Clear
pt.TableRange2.Clear
Next pt
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
FirstProgress
CreditReport
SecondProgress
PrintHeadingPvt
ThirdProgress
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & NameReport.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton161_Click()
CreditSheet
End Sub
Private Sub CommandButton162_Click()
Feature.Show
End Sub
Private Sub CommandButton35_Click()
'
productsub = 0
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Product-WareHouse-Customer"
PivotTableOptions.ReportName.Value = "Product-WareHouse-Customer"
AddCode
StartPivot
ProdWareCust
SalesReportOptions
ProdWareTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton36_Click()
'
productsub = 0
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Product-SalesPerson-Customer"
PivotTableOptions.ReportName.Value = "Product-SalesPerson-Customer"
AddCode
StartPivot
ProdSalesCust
SalesReportOptions
ProdSalesTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton37_Click()
'
productsub = 0
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Product-Customer"
PivotTableOptions.ReportName.Value = "Product-Customer"
AddCode
StartPivot
ProdCust
SalesReportOptions
ProdTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton38_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Customer"
PivotTableOptions.ReportName.Value = "Customer"
StartPivot
Customer
SalesReportOptions
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton49_Click()
'
productsub = 1
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "SalesPerson-Product"
PivotTableOptions.ReportName.Value = "SalesPerson-Product"
AddCode
StartPivot
SalesProd
SalesReportOptions
SalesTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton50_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
AddCode
StartPivot
SalesProdCust
SalesReportOptions
SalesProdTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton51_Click()
'
productsub = 1
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "SalesPerson-Customer-Product"
PivotTableOptions.ReportName.Value = "SalesPerson-Customer-Product"
AddCode
StartPivot
SalesCustProd
SalesReportOptions
SalesCustTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton63_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "WareHouse-Customer-Product"
PivotTableOptions.ReportName.Value = "WareHouse-Customer-Product"
AddCode
StartPivot
WareCustProd
SalesReportOptions
WareCustTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton64_Click()
'
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "WareHouse-Product-Customer"
PivotTableOptions.ReportName.Value = "WareHouse-Product-Customer"
AddCode
PivotTableOptions.Show
StartPivot
WareProdCust
SalesReportOptions
WareProdTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton65_Click()
'
productsub = 1
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "WareHouse-Product"
PivotTableOptions.ReportName.Value = "WareHouse-Product"
AddCode
StartPivot
WareProd
SalesReportOptions
WareTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CustomerProducts_Click()
'
productsub = 1
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Product"
PivotTableOptions.ReportName.Value = "Product"
AddCode
StartPivot
Product
SalesReportOptions
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Sub CustomersProducts_Click()
'
productsub = 1
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Customer-Product"
PivotTableOptions.ReportName.Value = "Customer-Product"
AddCode
StartPivot
CustProd
SalesReportOptions
CustTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CustomersSlsPeopleProds_Click()
'
productsub = 1
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Customer-SalesPerson-Product"
PivotTableOptions.ReportName.Value = "Customer-SalesPerson-Product"
AddCode
StartPivot
CustSalesProd
SalesReportOptions
CustTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Private Sub CustomersWarehsesProducts_Click()
'
productsub = 1
Application.ScreenUpdating = True
Unload SalesReports
DoEvents
Application.ScreenUpdating = False
PivotTableOptions.Caption = "Customer-WareHouse-Product"
PivotTableOptions.ReportName.Value = "Customer-WareHouse-Product"
AddCode
StartPivot
CustWareProd
SalesReportOptions
CustWareTotals
ActiveSheet.PageSetup.RightHeader = "&""Arial,Bold""&12" & PivotTableOptions.RightHeader.Value
EndPivot
Application.ScreenUpdating = True
End Sub
Form 2:
Option Explicit
Dim col_Selection As New Collection
Public i As Integer
Private Function fnKeyPressFilter(ByVal KeyAscii As Integer, _
AcceptCharacters As String) As Integer
'// Accept the Delete Key to enable Editing!
If KeyAscii = 8 Then Exit Function
'// Is this Key in the list of characters to deny
If InStr(1, AcceptCharacters, Chr$(KeyAscii)) > 0 Then
fnKeyPressFilter = 0
Beep
Else
'// Must be OK
fnKeyPressFilter = KeyAscii
End If
End Function
Private Sub CommandButton1_Click()
Dim c
Application.ScreenUpdating = True
PivotTableOptions.Hide
DoEvents
i = 0
For Each c In PivotTableOptions.DataView.Controls
If TypeName(c) = "CheckBox" Then
If c.Value = True Then i = i + 1
End If
Next c
Application.ScreenUpdating = False
End Sub
Private Sub CommandButton2_Click()
PivotTableOptions.Hide
End
End Sub
Private Sub No_Click()
PivotTableOptions.NoSubTotals.Value = True
PivotTableOptions.ProductSubtotals.Visible = False
End Sub
Private Sub Reportname_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If fnKeyPressFilter(KeyAscii, "/\'[*") = 0 Then KeyAscii = 0
End Sub
Private Sub SortByItem_Click()
PivotTableOptions.NoSubTotals.Value = True
PivotTableOptions.ProductSubtotals.Visible = False
End Sub
Private Sub SortByProduct_Click()
If productsub = 1 Then
PivotTableOptions.ProductSubtotals.Visible = True
End If
End Sub
Private Sub UserForm_Initialize()
Dim ctl As Control
Dim chb_ctl As clsFormEvents
'Go through the checkboxes and add them to the frame
Set col_Selection = New Collection
For Each ctl In Me.DataView.Controls
If TypeName(ctl) = "CheckBox" Then
Set chb_ctl = New clsFormEvents
Set chb_ctl.chb = ctl
col_Selection.Add chb_ctl
End If
Next ctl
Me.ReportName.text = Me.Caption
Me.ReportName.SetFocus
Me.ReportName.SelStart = 0
Me.ReportName.SelLength = Len(Me.ReportName.text)
End Sub
Private Sub InfoSelect_Click()
Dim ctl As clsFormEvents
For Each ctl In col_Selection
ctl.selectall
Next ctl
End Sub
Private Sub InfoUnselect_Click()
Dim ctl As clsFormEvents
For Each ctl In col_Selection
ctl.unselectall
Next ctl
End Sub
Where I declare the variable:
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 productsub As Integer
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(Rows.Count, "A").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.SaveData = 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"
Else
pt.AddFields RowFields:=array("Customer", "Cust#")
End If
NoCustomerTotals
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Customer", "Cust#", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "Product")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Customer", "Cust#", "Product", "Item#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "Product", "Item#")
End If
If PivotTableOptions.NoSubTotals.Value = True Then
NoProdTotals
End If
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Customer", "Cust#", "Item#", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "Item#", "Product")
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
'DoTotals "Customer[All;Total]", 15
'DoTotals "Product[All;Total]", 37
End Sub
Sub CustProdSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Customer", "Cust#", "Product", "SlsPrson"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "Product", "SlsPrson")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Customer", "Cust#", "Product", "Item#", "SlsPrson"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "Product", "Item#", "SlsPrson")
End If
NoItemTotals
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Customer", "Cust#", "Item#", "Product", "SlsPrson"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "Item#", "Product", "SlsPrson")
End If
NoItemTotals
End If
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"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "SlsPrsn")
End If
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Customer", "Cust#", "SlsPrson", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "SlsPrson", "Product")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Customer", "Cust#", "SlsPrsn", "Product", "Item#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "SlsPrsn", "Product", "Item#")
End If
If PivotTableOptions.NoSubTotals.Value = True Then
NoProdTotals
End If
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Customer", "Cust#", "SlsPrsn", "Item#", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "SlsPrsn", "Item#", "Product")
End If
NoItemTotals
End If
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"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "SlsPrsn", "Whse")
End If
NoCustTotal
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub CustWareProd()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Customer", "Cust#", "Whse", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "Whse", "Product")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Customer", "Cust#", "Whse", "Product", "Item#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "Whse", "Product", "Item#")
End If
If PivotTableOptions.NoSubTotals.Value = True Then
NoProdTotals
End If
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Customer", "Cust#", "Whse", "Item#", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "Whse", "Item#", "Product")
End If
NoItemTotals
End If
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"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "Whse")
End If
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"
Else
pt.AddFields RowFields:=array("Customer", "Cust#", "Whse", "SlsPrsn")
End If
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Item#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Item#")
End If
If PivotTableOptions.NoSubTotals.Value = True Then
NoProdTotals
End If
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Item#", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Item#", "Product")
End If
NoItemTotals
End If
pvt.Activate
pt.ManualUpdate = False
SecondProgress
End Sub
Sub ProdCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Customer", "Cust#")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Item#", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Item#", "Customer", "Cust#")
End If
NoItemTotals
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Item#", "Product", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Item#", "Product", "Customer", "Cust#")
End If
NoItemTotals
End If
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Customer", "Cust#", "SlsPrsn"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Customer", "Cust#", "SlsPrsn")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Item#", "Customer", "Cust#", "SlsPrsn"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Item#", "Customer", "Cust#", "SlsPrsn")
End If
NoItemTotals
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Item#", "Product", "Customer", "Cust#", "SlsPrsn"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Item#", "Product", "Customer", "Cust#", "SlsPrsn")
End If
NoItemTotals
End If
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Customer", "Cust#", "Whse"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Customer", "Cust#", "Whse")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Item#", "Customer", "Cust#", "Whse"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Item#", "Customer", "Cust#", "Whse")
End If
NoItemTotals
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Item#", "Product", "Customer", "Cust#", "Whse"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Item#", "Product", "Customer", "Cust#", "Whse")
End If
NoItemTotals
End If
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdSales()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "SlsPrsn"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "SlsPrsn")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Item#", "SlsPrsn"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Item#", "SlsPrsn")
End If
NoItemTotals
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Item#", "Product", "SlsPrsn"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Item#", "Product", "SlsPrsn")
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "SlsPrsn", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "SlsPrsn", "Customer", "Cust#")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Item#", "SlsPrsn", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Item#", "SlsPrsn", "Customer", "Cust#")
End If
NoItemTotals
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Item#", "Product", "SlsPrsn", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Item#", "Product", "SlsPrsn", "Customer", "Cust#")
End If
NoItemTotals
End If
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "SlsPrsn", "Whse"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "SlsPrsn", "Whse")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Item#", "SlsPrsn", "Whse"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Item#", "SlsPrsn", "Whse")
End If
NoItemTotals
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Item#", "Product", "SlsPrsn", "Whse"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Item#", "Product", "SlsPrsn", "Whse"), ColumnFields:="Date"
End If
NoItemTotals
End If
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdWare()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Whse"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Whse")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Item#", "Whse"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Item#", "Whse")
End If
NoItemTotals
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Item#", "Product", "Whse"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Item#", "Product", "Whse")
End If
NoItemTotals
End If
sb.Show "Please wait", "Running...", 0
SecondProgress
End Sub
Sub ProdWareCust()
'Add Fields to Pivot Table
On Error Resume Next
If PivotTableOptions.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Whse", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Whse", "Customer", "Cust#")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Item#", "Whse", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Item#", "Whse", "Customer", "Cust#")
End If
NoItemTotals
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Item#", "Product", "Whse", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Item#", "Product", "Whse", "Customer", "Cust#")
End If
NoItemTotals
End If
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Whse", "SlsPrsn"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Whse", "SlsPrsn")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Product", "Item#", "Whse", "SlsPrsn"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Product", "Item#", "Whse", "SlsPrsn")
End If
NoItemTotals
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Item#", "Product", "Whse", "SlsPrsn"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Item#", "Product", "Whse", "SlsPrsn")
End If
NoItemTotals
End If
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"
Else
pt.AddFields RowFields:=array("SlsPrson")
End If
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("SlsPrsn", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("SlsPrsn", "Product")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("SlsPrsn", "Product", "Item#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("SlsPrsn", "Product", "Item#")
End If
If PivotTableOptions.NoSubTotals.Value = True Then
NoProdTotals
End If
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("SlsPrsn", "Item#", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("SlsPrsn", "Item#", "Product")
End If
NoProdTotals
End If
sb.Show True
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("SlsPrsn", "Customer", "Cust#", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("SlsPrsn", "Customer", "Cust#", "Product")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("SlsPrsn", "Customer", "Cust#", "Product", "Item#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("SlsPrsn", "Customer", "Cust#", "Product", "Item#")
End If
If PivotTableOptions.NoSubTotals.Value = True Then
NoProdTotals
End If
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("SlsPrsn", "Customer", "Cust#", "Item#", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("SlsPrsn", "Customer", "Cust#", "Item#", "Product")
End If
NoItemTotals
End If
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"
Else
pt.AddFields RowFields:=array("SlsPrsn", "Customer", "Cust#")
End If
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"
Else
pt.AddFields RowFields:=array("SlsPrsn", "Customer", "Cust#", "Whse")
End If
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("SlsPrsn", "Product", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("SlsPrsn", "Product", "Customer", "Cust#")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("SlsPrsn", "Product", "Item#", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("SlsPrsn", "Product", "Item#", "Customer", "Cust#")
End If
NoItemTotals
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("SlsPrsn", "Item#", "Product", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("SlsPrsn", "Item#", "Product", "Customer", "Cust#")
End If
NoItemTotals
End If
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("SlsPrsn", "Product", "Whse"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("SlsPrsn", "Product", "Whse")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("SlsPrsn", "Product", "Item#", "Whse"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("SlsPrsn", "Product", "Item#", "Whse")
End If
NoItemTotals
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("SlsPrsn", "Item#", "Product", "Whse"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("SlsPrsn", "Item#", "Product", "Whse")
End If
NoItemTotals
End If
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"
Else
pt.AddFields RowFields:=array("Whse")
End If
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Whse", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Whse", "Product")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Whse", "Product", "Item#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Whse", "Product", "Item#")
End If
If PivotTableOptions.NoSubTotals.Value = True Then
NoProdTotals
End If
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Whse", "Item#", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Whse", "Item#", "Product")
End If
NoItemTotals
End If
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Whse", "Product", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Whse", "Product", "Customer", "Cust#")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Whse", "Product", "Item#", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Whse", "Product", "Item#", "Customer", "Cust#")
End If
NoItemTotals
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Whse", "Item#", "Product", "Customer", "Cust#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Whse", "Item#", "Product", "Customer", "Cust#")
End If
NoItemTotals
End If
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Whse", "Product", "SlsPrsn"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Whse", "Product", "SlsPrsn")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Whse", "Product", "Item#", "SlsPrsn"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Whse", "Product", "Item#", "SlsPrsn")
End If
NoItemTotals
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Whse", "Item#", "Product", "SlsPrsn"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Whse", "Item#", "Product", "SlsPrsn")
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.No.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Whse", "Customer", "Cust#", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Whse", "Customer", "Cust#", "Product")
End If
ElseIf PivotTableOptions.SortByProduct.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Whse", "Customer", "Cust#", "Product", "Item#"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Whse", "Customer", "Cust#", "Product", "Item#")
End If
NoCustTotal
If PivotTableOptions.NoSubTotals.Value = True Then
NoProdTotals
End If
ElseIf PivotTableOptions.SortByItem.Value = True Then
If PivotTableOptions.NoDate.Value = False Then
pt.AddFields RowFields:=array("Whse", "Customer", "Cust#", "Item#", "Product"), ColumnFields:="Date"
Else
pt.AddFields RowFields:=array("Whse", "Customer", "Cust#", "Item#", "Product")
End If
NoCustTotal
NoItemTotals
End If
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"
Else
pt.AddFields RowFields:=array("Whse", "Customer", "Cust#")
End If
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"
Else
pt.AddFields RowFields:=array("Whse", "Customer", "Cust#", "SlsPrsn")
End If
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(Rows.Count, "A").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.SaveData = 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"
ElseIf 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
ElseIf 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
ElseIf 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()
sb.Show "Please wait", "Running...", 0
'Create sheet
Err.Clear
If OrderSheetOptions.OrderForm.Value = True Then
myInput = "SalesPerson Order Form"
If SheetExists(myInput) Then
MsgBox "You have already created an Order Sheet for this File"
End
End If
End If
If OrderSheetOptions.Report.Value = True Then
myInput = "SalesPerson Order Report"
If SheetExists(myInput) Then
MsgBox "You have already created an Order Report for this File"
End
End If
ActiveSheet.Name = myInput
End If
detail.Copy After:=Sheets(1)
ActiveSheet.Name = myInput
On Error Resume Next
Columns("N:N").Replace What:="0", Replacement:="", LookAt:=xlWhole
Range(Cells(2, 14), Cells(Rows.Count, 14).End(xlUp)) _
.SpecialCells(xlCellTypeBlanks).EntireRow.delete
'Mark Items to Keep
Rows("1:1").Hidden = True
On Error Resume Next
dataToKeep = array("AT", "Invoice#")
Rows(1).Insert
Cells(1, 1) = "Sacrifice"
Columns(1).Insert
For Each keep In dataToKeep
Cells.AutoFilter Field:=2, Criteria1:=keep & "*"
Intersect(ActiveSheet.UsedRange, _
Columns(2).SpecialCells(xlCellTypeVisible)).Offset(, -1) = "x"
Cells.AutoFilter
Next
'Delete unmarked rows
Cells.AutoFilter Field:=1, Criteria1:="="
Intersect(ActiveSheet.UsedRange, _
Columns(2).SpecialCells(xlCellTypeVisible)).EntireRow.delete
Columns(1).EntireColumn.delete
Set dataToKeep = Nothing
Set keep = Nothing
'Clean up Report
finalRow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(finalRow, "A").EntireRow.delete
Range("A:A,C:D,G:H,K:K,M:M,P:U").delete shift:=xlToLeft
For i = 2 To finalRow
Cells(i, 1).Resize(1, 8).Interior.ColorIndex = xlNone
Next
'Sort Rows
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:= _
Range("E2"), Order2:=xlAscending, Key3:=Range("A2"), Order3:=xlDescending, Header:=xlYes
finalRow = Cells(Rows.Count, "A").End(xlUp).Row
'Add and Remove Rows
Columns("A:A").Cut
Columns("F:F").Insert shift:=xlToRight
Columns("A:A").Cut
Columns("C:C").Insert shift:=xlToRight
Columns("C:C").Cut
Columns("E:E").Insert shift:=xlToRight
Columns("E:E").Columns.Insert shift:=xlToRight
Columns("K:K").Columns.Insert shift:=xlToRight
'Perform Calculations
For i = 2 To finalRow
If Cells(i, "C") = Cells(i + 1, "C").Value Then
Range("J" & i).FormulaR1C1 = "=RC[-2]-R[1]C[-2]"
If Range("J" & i) < 0.01 & Range("J" & i) > -0.01 Then
Range("J" & i).ClearContents
End If
Range("K" & i).FormulaR1C1 = "=(RC[-5]-R[1]C[-5])/7"
If Range("K" & i) < 1 Then
Range("K" & i).ClearContents
End If
End If
Range("O" & i).FormulaR1C1 = "=Today()"
Range("E" & i).FormulaR1C1 = "=(RC[10]-RC[1])/7"
Next
Range("E1:E" & Cells(Rows.Count, 1).End(xlUp).Row).Value = _
Range("E1:E" & Cells(Rows.Count, 1).End(xlUp).Row).Value
Range("J1:J" & Cells(Rows.Count, 1).End(xlUp).Row).Value = _
Range("J1:J" & Cells(Rows.Count, 1).End(xlUp).Row).Value
Range("K1:K" & Cells(Rows.Count, 1).End(xlUp).Row).Value = _
Range("K1:K" & Cells(Rows.Count, 1).End(xlUp).Row).Value
Range("O:O").EntireColumn.delete
'Delete Extra rows
For i = finalRow To 2 Step -1
If Cells(i, "C") = Cells(i - 1, "C").Value Then
Cells(i, "C").EntireRow.delete
Else
End If
Next
'Add Column Headings
Range("E1").FormulaR1C1 = "Wks Since"
Range("F1").FormulaR1C1 = "Last Date"
Range("G1").FormulaR1C1 = "Qty"
Range("H1").FormulaR1C1 = "Last Price"
Range("J1").FormulaR1C1 = "Price Change"
Range("K1").FormulaR1C1 = "Wks Prior"
Range("E1", "L1").WrapText = True
Range("1:1").Rows.AutoFit
'Delete blank rows
Rows(1).Insert
Cells(1, 1) = "Sacrifice"
On Error Resume Next
Cells.AutoFilter Field:=1, Criteria1:="", Field:=2, Criteria2:="="
Intersect(ActiveSheet.UsedRange, _
Columns(1).SpecialCells(xlCellTypeVisible)).EntireRow.delete
finalRow = Cells(Rows.Count, "A").End(xlUp).Row
'Pick Report Type
If OrderSheetOptions.OrderForm.Value = True Then
For i = 3 To finalRow Step 2
Cells(i, 1).Resize(1, 14).Interior.ColorIndex = 34
Next
For i = finalRow To 3 Step -1
If Cells(i, "A").Value <> Cells(i - 1, "A").Value Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(i, "A")
End If
Next
Range("L1").FormulaR1C1 = "Date ______"
Range("M1").FormulaR1C1 = "Date ______"
Range("N1").FormulaR1C1 = "Date ______"
With Range("L1", "N1")
.Font.Bold = True
.Font.Size = 8
.WrapText = True
.Columns.AutoFit
End With
Else
For i = 3 To finalRow Step 2
Cells(i, 1).Resize(1, 11).Interior.ColorIndex = 34
Next
End If
'Format Report
With Range("I1", "K1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
.WrapText = True
End With
Range("I:K").Font.Size = 8
With Range("E:E")
.NumberFormat = "0"
.HorizontalAlignment = xlCenter
End With
With Range("K:K")
.NumberFormat = "0"
.HorizontalAlignment = xlCenter
End With
PrintHeadingPvt
With ActiveSheet.PageSetup
.RightHeader = "&""Arial,Bold""&12" & detail.Range("H2").Value
End With
Range("B:B").HorizontalAlignment = xlCenter
Range("D:D").HorizontalAlignment = xlCenter
Range("A:A").ColumnWidth = 20
Range("K:K").ColumnWidth = 4.6
Range("C:O").Columns.AutoFit
'Change Print Orientation if Orderform
If OrderSheetOptions.OrderForm = True Then
With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With
End If
Application.ScreenUpdating = 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
With pt.PivotFields("Unit Cost ($)")
.Name = "Unt Cost"
End With
With pt.PivotFields("Price ($)")
.Name = "Price"
End With
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(Rows.Count, "A").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 CreditReport()
sb.Show "Please wait", "Running...", 0
'Add Fields to Pivot Table
pt.AddFields RowFields:=array("Customer", "Cust#", "Invoice#", "Product", "SlsPrsn", "Date")
NoDateTotals
NoCustTotal
NoSlsTotals
NoProdTotals
AddCases
AddUnits
AddAmt
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
pt.PivotSelect "Invoice#[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
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
ElseIf PivotTableOptions.Amount.Value = True Then
AddAmt
ElseIf PivotTableOptions.Profit.Value = True Then
AddProfit
ElseIf PivotTableOptions.ProfitPerc.Value = True Then
AddPercentage
ElseIf PivotTableOptions.Units.Value = True Then
AddUnits
ElseIf PivotTableOptions.Cost.Value = True Then
AddTotalCost
ElseIf PivotTableOptions.UnitCost.Value = True Then
AddUnitCost
ElseIf PivotTableOptions.Price.Value = True Then
AddPrice
End If
Else
If PivotTableOptions.Cases.Value = True Then AddCases
If PivotTableOptions.Amount.Value = True Then AddAmt
If PivotTableOptions.Profit.Value = True Then AddProfit
If PivotTableOptions.ProfitPerc.Value = True Then AddPercentage
If PivotTableOptions.Units.Value = True Then AddUnits
If PivotTableOptions.Cost.Value = True Then AddTotalCost
If PivotTableOptions.UnitCost.Value = True Then AddUnitCost
If PivotTableOptions.Price.Value = True Then AddPrice
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
With Range(Range("IV2").End(xlToLeft), "A1")
Range("IV2").Select
Selection.End(xlToLeft).Select
Range(Selection, "A1").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
Application.Calculation = xlCalculationAutomatic
End Sub
I didn't want to post all that because you will be shifting through too much. And it is hard for me to post a sample workbook because I would have to alter the code to work with it. I am giving you all the code that pertains to this problem but here is More code like you ask.
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.