PDA

View Full Version : Passing a variable into a Private sub



Djblois
02-01-2007, 10:06 AM
I am using a variable (productSub) that I declare publicly and then when a user hits a particular button it sets the variable to either 0 or 1 depending on the button. However it keeps telling me Object required on the line

set productSub = 1

That line is in the Private sub of the button but I can't get it to work.

I have tested many things to get it to work. I have made the sub not private. I have changed the data type of productSub. I just can't get it to work

Bob Phillips
02-01-2007, 10:08 AM
It isn't an object, so no Set required



productSub = 1

Djblois
02-01-2007, 10:36 AM
ok, that works. Now I am using it in another form to make a control visible or not. Here is the code:

If productsub = 1 Then
PivotTableOptions.ProductSubtotals.Visible = True
End If

and it doesn't recognize it

Norie
02-01-2007, 11:14 AM
Where have you declared the variable?

Or are you actually passing it as a parameter?

PS Might help if you posted a little more code.:)

Djblois
02-01-2007, 11:19 AM
I am declaring in the first userform module. I try to post only the code I think is relevant but here is more:

in the first button:

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

In the Second User form:

Private Sub SortByProduct_Click()

If productsub = 1 Then
PivotTableOptions.ProductSubtotals.Visible = True
End If

End Sub

Norie
02-01-2007, 11:26 AM
Eh, a relevant part of the code might be that where you actually declare the variable.:)

In what you've posted so far it isn't declared anywhere and isn't passed as a parameter either.

You should probably take a look at the VBA Help topic Understanding Scope and Visibility.

Djblois
02-01-2007, 11:49 AM
I declared it publicly with the first form. I didn't want to post the whole forms code because none of the rest seems relevant.

Norie
02-01-2007, 11:53 AM
You've posted no code that declares a variable.:)

This is not a declaration.

productsub = 1

It will create a variable but it's scope will only be within that sub.

Djblois
02-01-2007, 11:57 AM
Thank you how do I expand the scope beyond the sub? Here is the declaration:

Public productsub As Integer

Norie
02-01-2007, 12:00 PM
Is this in a userform module?

If it is it shouldn't be.:)

Did you check the help topic?

I really think you might find it of use.

Djblois
02-01-2007, 12:12 PM
Ok now I know I have to declare it publicly in another mod. However it still isn't working

Norie
02-01-2007, 12:20 PM
Another mod?

Which one?

PS It really would help if you either posted all the code or attached a workbook.:)

lucas
02-01-2007, 12:22 PM
I don't think so if all of your button click private subs are in the same module....the userform mod

Djblois
02-01-2007, 12:27 PM
yes but then I use that number in a seperate userform

Norie
02-01-2007, 12:32 PM
I think I'm going to leave this one alone for a bit.:)

We aren't just asking question for no reason.

The more information/code you give us the more help we can give.

Hope you get it sorted, I'll check back later.

lucas
02-01-2007, 12:35 PM
From the help files.....always a last resort:


Defining Public Module-Level Scope

If you declare a module-level variable as public, it's available to all procedures in the project. In the following example, the string variable strMsg can be used by any procedure in any module in the project.
' Include in Declarations section of module.Public strMsg As StringAll procedures are public by default, except for event procedures. When Visual Basic creates an event procedure, the Private keyword is automatically inserted before the procedure declaration. For all other procedures, you must explicitly declare the procedure with the Private keyword if you do not want it to be public.
You can use public procedures, variables, and constants defined in standard modules or class modules from referencing projects. However, you must first set a reference to the project in which they are defined.
Public procedures, variables, and constants defined in other than standard or class modules, such as form modules or report modules, are not available to referencing projects, because these modules are private to the project in which they reside.

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.

lucas
02-01-2007, 12:41 PM
So Daniel,
is this declaration:


Public productsub As Integer

in a userform module?

Public procedures, variables, and constants defined in other than standard or class modules, such as form modules or report modules, are not available to referencing projects
Looks like it should be in a standard module or a class module....

Djblois
02-01-2007, 12:45 PM
I put it in a standard module now and it still doesn't recognize it

lucas
02-01-2007, 12:46 PM
I've got to say daniel that the way you post volumes of code when you get frustrated at questions is a bit spiteful......I also am signing off on this thread...good luck.

Djblois
02-01-2007, 12:51 PM
I am not trying to be spiteful. He asked to see more code and I don't know what code he wanted to see? I already posted all the code I was using for this problem. But he still asked to see more code. I am sorry if that is how it sounded. I have previously said my code is huge, so I try to cut it up to pieces that are relavant to the problem only.

lucas
02-01-2007, 01:11 PM
My last word on this:
In this thread:
Post #4 Norie asks specifically where you have declared the variable
Post #5 You posted click procedures from a userform
Post #6 Norie posts:"Eh, a relevant part of the code might be that where you actually declare the variable(with a smiley face)"
Post #7 you state that you have declared it publicly in the module for the first form.
Post #10 Norie asks "Is this in a userform module? If it is it shouldn't be."
etc.

You should really read back through this and try to see the problem from others (who are trying to help) point of view. Another example is your rambling in the <1 thread where you post your thoughts almost it seems as they come to mind....

Please slow down just a little(I know, your under pressure at work....aren't we all) and remember that these folks are volunteering to help solve your problems and just try to be as clear as possible with your questions. Think about it a little before you post. Most importantly.....answer the questions. Don't just post back immediately...think about how to help us understand the problem and try to give us the relevant information so we can help..

Bob Phillips
02-01-2007, 02:19 PM
I've got to say daniel that the way you post volumes of code when you get frustrated at questions is a bit spiteful......I also am signing off on this thread...good luck.

Be fair Steve, the guy originally posted just the code that he thought was relevant. Norie kept on pushing for more, and finally he got more.

The problem as I see it is tha djblois is taking on more than he can handle. Rather than build it up bit by bit, properly understanding it, he has jumped right in, and struggles to see the wood for the trees.

mdmackillop
02-01-2007, 02:35 PM
I've not tried to follow your code, but here's a simple example

Justinlabenne
02-02-2007, 03:03 PM
You don't necessarily have to make ProductSub public and place it in a standard module. It can be accessed inside another form: