We help IT Professionals succeed at work.

Excel 2013 Pivot Table Form

FFNStaff
FFNStaff asked
on
65 Views
Last Modified: 2016-04-19
Hello,

In Excel, I have created a sheet/form for each sales person with annual totals pulled into a pivot table (a sample of what I am working with is attached).  The yellow and blue areas are on each page and green is the data from the pivot table.  The green will be personalized for each sales person.  

2 questions:  

1.  In the yellow area, where the XXXXs are, I want to pull the name of the sales person.  I tried using a basic =a6 which put the first sales person's name on each of the following sheets too.  Is there a way to personalize the sheet name for the person the data is for?  

2.  Is there a way to put information not included in the pivot table in the white space between the green and blue space? Perhaps using Visual Basic?  I want to put some statistical information that would be the same on each sheet but is too cumbersome for the footer.  (I've used VB in the past  but wouldn't know the text to use.)

Thank you!

Pat
Sales-Summary.xlsx
Comment
Watch Question

byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
Pat,
Could you please post some sample source data so we can give you the code to produce the desired PivotTables? We don't need much data (say 20 rows showing at least two salesmen, with sales on at least 2 years, and at least 2 different products), but layout and column header labels are critical.

Brad
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
Here are some macros that will create a Table as the source of data for a PivotTable, then use that PivotTable to create separate reports for each salesperson. A disclaimer text will be placed underneath each report.

The disclaimer text is defined in sub Reporter near the top. Change it to suit.

As written, the macro assumes that the raw data has header labels Salesperson, Sale, Date and Product starting in cell A1 of worksheet Data. If your worksheet name, data location or header labels are different, please change the code accordingly (many places).

The attached workbook has a button on worksheet Data. Click it, and the reports will be generated.

If you have difficulty adapting the code to your actual workbook, please post your attempt to modify the macros in a workbook with sample data. Layout, header label text and worksheet names are important--as you will find when you edit the code.
Sub Reporter()
Dim PT As PivotTable
Dim Disclaimer As String, PTname As String, tbName As String, Salesperson As String
Dim celHome As Range, Salespersons As Range
Dim tb As ListObject
Dim wsData As Worksheet, wsPT As Worksheet
Dim i As Long, n As Long

PTname = "PivotTable1"
tbName = "Table1"
Disclaimer = "Footer Disclaimer text"

Application.ScreenUpdating = False
Set celHome = ActiveCell
With ActiveWorkbook
    Set wsData = .Worksheets("Data")
    
    On Error Resume Next
    Set tb = wsData.ListObjects(tbName)
    If tb Is Nothing Then MakeTable wsData, tbName
    
    Set wsPT = .Worksheets("Salesperson PT")
    If wsPT Is Nothing Then
        Set wsPT = .Worksheets.Add(after:=wsData)
        wsPT.Name = "Salesperson PT"
    End If
    
    Set PT = wsPT.PivotTables(PTname)
    On Error GoTo 0
    
    If PT Is Nothing Then
        MakePivotTable tbName, PTname, wsPT
        Set PT = wsPT.PivotTables(PTname)
    Else
        PT.PivotCache.Refresh
    End If
End With

n = PT.PivotFields("Salesperson").PivotItems.Count
For i = 1 To n
    Salesperson = PT.PivotFields("Salesperson").PivotItems(i)
    ReportSalesperson PT, Salesperson, Disclaimer
Next
Application.Goto celHome
End Sub

Sub MakeTable(ws As Worksheet, tbName As String)
With ws
    .ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes).Name = tbName
End With
End Sub

Sub MakePivotTable(tbName As String, PTname As String, ws As Worksheet)
Dim PT As PivotTable
ws.Parent.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=tbName).CreatePivotTable _
    TableDestination:="'" & ws.Name & "'!R3C1", TableName:=PTname

With ws.PivotTables(PTname)
    .PivotFields("Salesperson").Orientation = xlPageField
    .PivotFields("Salesperson").Position = 1

    .PivotFields("Product").Orientation = xlRowField
    .PivotFields("Product").Position = 1
    
    .PivotFields("Date").Orientation = xlColumnField
    .PivotFields("Date").Position = 1

    .AddDataField .PivotFields("Sale"), "Sum of Sale", xlSum
    
    .ColumnRange.Cells(2, 1).Group Start:=True, End:=True, Periods:=Array(False, False, False, False, False, False, True)
    .RowGrand = False
End With
End Sub

Sub ReportSalesperson(PT As PivotTable, Salesperson As String, Disclaimer As String)
Dim ws As Worksheet
PT.PivotFields("Salesperson").ClearAllFilters
PT.PivotFields("Salesperson").CurrentPage = Salesperson

On Error Resume Next
Set ws = Worksheets(Salesperson)
On Error GoTo 0
If ws Is Nothing Then
    Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    ws.Name = Salesperson
Else
    ws.UsedRange.ClearContents
End If

With ws.Range("G1:G2")
    .Cells(1, 1).Value = "Sales Summary for"
    .Cells(2, 1).Value = Salesperson
    .HorizontalAlignment = xlRight
End With

PT.TableRange2.Copy
ws.Range("A3").PasteSpecial xlPasteValuesAndNumberFormats
PT.PivotFields("Salesperson").ClearAllFilters

With ws
    .Range("A3:B3").ClearContents
    .UsedRange.EntireColumn.AutoFit
    .UsedRange.Cells(.UsedRange.Rows.Count + 2, 1).Value = Disclaimer
End With
End Sub

Open in new window

Sales-SummaryPT_Q28935114.xlsm

Author

Commented:
Brad, here is an updated spreadsheet with the data requested.

Byundt, thank you for all the work you put into this question!  I have the pivot tables formatted so each person's data is on its own page so this is really more than I need.
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
Pat,
Please try again to attach the updated spreadsheet.

1. Click the Attach File link at the bottom of the Comment box
2. In the file browser that appears, select your file, then click the 'Open' button
3. Back in the web browser, click the Upload File button
4. You will then see a description field appear. You must put some text in that field, otherwise the file attachment will fail.

Brad

Author

Commented:
Brad, I just realized you are Byundt too.  Sorry about that...

Author

Commented:
Updated document.
Sales-Summary.xlsx
byundtMechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013

Commented:
To produce the desired reports, it is necessary to unpivot the original data. I added a sub for this purpose, and also gathered all the labels that might need changing into one section (with comments) in the Reporter sub.
Sub Reporter()
Dim PT As PivotTable
Dim Disclaimer As String, PTname As String, tbName As String, Salesperson As String
Dim sData As String, sDate As String, sProduct As String, sPT As String, sSalesperson As String, sSales As String
Dim celHome As Range, Salespersons As Range
Dim tb As ListObject
Dim wsData As Worksheet, wsPT As Worksheet
Dim i As Long, n As Long

    'Change these text values to match your workbook
PTname = "PivotTable1"  'Name of PivotTable
tbName = "Table1"       'Name of Table used as data source
Disclaimer = "Footer Disclaimer text"   'Text used as disclaimer in footer of each salesperson's report
sSalesperson = "Sales Person"       'Header label in data source
sProduct = "PT_name"                'Header label in data source
sSales = "Sales"                    'Header label in data source
sDate = "Date"                      'Header label in data source
sPT = "Salesperson PT"      'Name of PivotTable worksheet

Application.ScreenUpdating = False
Set celHome = ActiveCell
With ActiveWorkbook
    Set wsData = ActiveSheet
    sData = wsData.Name
    Unpivot wsData, sDate, sSales
    
    On Error Resume Next
    Set tb = wsData.ListObjects(tbName)
    If tb Is Nothing Then MakeTable wsData, tbName
    
    Set wsPT = .Worksheets(sPT)
    If wsPT Is Nothing Then
        Set wsPT = .Worksheets.Add(after:=wsData)
        wsPT.Name = "Salesperson PT"
    End If
    
    Set PT = wsPT.PivotTables(PTname)
    On Error GoTo 0
    
    If PT Is Nothing Then
        MakePivotTable tbName, PTname, wsPT, sSalesperson, sProduct, sDate, sSales
        Set PT = wsPT.PivotTables(PTname)
    Else
        PT.PivotCache.Refresh
    End If
End With

n = PT.PivotFields(sSalesperson).PivotItems.Count
For i = 1 To n
    Salesperson = PT.PivotFields(sSalesperson).PivotItems(i)
    ReportSalesperson PT, Salesperson, Disclaimer, sSalesperson
Next
Application.Goto celHome
End Sub

Sub MakeTable(ws As Worksheet, tbName As String)
With ws
    .ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes).Name = tbName
End With
End Sub

Sub MakePivotTable(tbName As String, PTname As String, ws As Worksheet, _
    sSalesperson As String, sProduct As String, sDate As String, sSales As String)
Dim PT As PivotTable
ws.Parent.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=tbName).CreatePivotTable _
    TableDestination:="'" & ws.Name & "'!R3C1", TableName:=PTname

With ws.PivotTables(PTname)
    .PivotFields(sSalesperson).Orientation = xlPageField
    .PivotFields(sSalesperson).Position = 1

    .PivotFields(sProduct).Orientation = xlRowField
    .PivotFields(sProduct).Position = 1
    
    .PivotFields(sDate).Orientation = xlColumnField
    .PivotFields(sDate).Position = 1

    .AddDataField .PivotFields(sSales), "Sum of " & sSales, xlSum
    
    '.ColumnRange.Cells(2, 1).Group Start:=True, End:=True, Periods:=Array(False, False, False, False, False, False, True)
    .DataBodyRange.NumberFormat = "$#,##0.00;-$#,##0.00;;@"
    .RowGrand = False
End With
End Sub

Sub ReportSalesperson(PT As PivotTable, Salesperson As String, Disclaimer As String, sSalesperson As String)
Dim ws As Worksheet
PT.PivotFields(sSalesperson).ClearAllFilters
PT.PivotFields(sSalesperson).CurrentPage = Salesperson

On Error Resume Next
Set ws = Worksheets(Salesperson)
On Error GoTo 0
If ws Is Nothing Then
    Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    ws.Name = Salesperson
Else
    ws.UsedRange.ClearContents
End If

With ws.Range("G1:G2")
    .Cells(1, 1).Value = "Sales Summary for"
    .Cells(2, 1).Value = Salesperson
    .HorizontalAlignment = xlRight
End With

PT.TableRange2.Copy
ws.Range("A3").PasteSpecial xlPasteValuesAndNumberFormats
PT.PivotFields(sSalesperson).ClearAllFilters

With ws
    .Range("A3:B3").ClearContents
    .Range("B5").ClearContents
    .Range("A6").ClearContents
    .UsedRange.EntireColumn.AutoFit
    .UsedRange.Cells(.UsedRange.Rows.Count + 2, 1).Value = Disclaimer
End With
End Sub

Sub Unpivot(ws As Worksheet, sDate As String, sSales As String)
'Unpivots the data so it can be used to build a different PivotTable
Dim cel As Range, col As Range, rg As Range, rgFixed As Range, rgHeaders As Range
Dim j As Long, nCols As Long, nFixed As Long, nRows As Long
nFixed = 2      'Number of fixed columns in data being unpivoted
With ws
    Set rg = .UsedRange
    Set rgHeaders = rg.Rows(1)
    Set rg = rg.Offset(1, 0).Resize(rg.Rows.Count - 1, rg.Columns.Count)
    Set rgFixed = rg.Resize(, nFixed)
    nCols = rg.Columns.Count
    nRows = rg.Rows.Count
    
    For j = nFixed + 2 To nCols
        Set cel = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
        rgFixed.Copy cel
        rg.Columns(j).Copy cel.Offset(0, nFixed)
        rgHeaders.Cells(1, j).Copy
        cel.Offset(0, nFixed + 1).Resize(nRows, 1).PasteSpecial xlPasteValuesAndNumberFormats
    Next
    rg.Columns(nFixed + 2).Resize(nRows, nCols - nFixed - 1).ClearContents
    rgHeaders.Cells(1, nFixed + 1).Copy
    rg.Columns(nFixed + 2).PasteSpecial xlPasteValuesAndNumberFormats
    rgHeaders.Cells(1, nFixed + 3).Resize(1, nCols - nFixed - 2).Clear
    rgHeaders.Cells(1, nFixed + 1).Value = sSales
    rgHeaders.Cells(1, nFixed + 2).Value = sDate
End With
End Sub

Open in new window

Sales-SummaryPT_Q28935114.xlsm

Author

Commented:
Brad, I appreciate all the effort you have put into this question.  This code is just too much for me to manage.    
 
When I clicked on the "Report by Salesperson" button, a run time error came up on this:
 On Error Resume Next
    Set tb = wsData.ListObjects(tbName)
    If tb Is Nothing Then MakeTable wsData, tbName

I have so much of the sheet the way I need it that using your code would be basically starting over.  All I really need is a way to put the correct sales person's name in a certain cell at the top of the page.  

Reading through your code, I see the sub-routine ReportSalesperson.  Could we just use that portion of the code to get the name?  I am using another sheet that lists thesales people.  The pages of the pivot table would correspond with each line of sheet with the sales people listed.

Your thoughts?

Pat
Mechanical Engineer
CERTIFIED EXPERT
Most Valuable Expert 2013
Top Expert 2013
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION

Author

Commented:
Thank you for your help, Brad.
TracyVBA Developer
CERTIFIED EXPERT

Commented:
I've requested that this question be closed as follows:

Accepted answer: 500 points for byundt's comment #a41521789

for the following reason:

This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.