Macro to produce Pivot based on a Data set

L

ldashev

New Member
Joined
Mar 24, 2016
Messages
49
Hi,

Could someone help design a macro to design a pivot based on this piece of data:

The two columns that I need in the pivot are company and amount (but need to adjust number format field to $ sign) and introduce a new field that would reflect the ratio each company represents from gross amount. I will post what I'd like the pivot to look like in the next post.

DateIDREf #AmountCompany
2/27/2017111201701100IBM
2/27/2017222201702100HP
2/27/2017333201703500IBM
2/27/2017444201704200Ford
2/27/2017555201705300IBM
2/27/2017666201706600IBM
2/27/2017777201707200HP

<tbody>
</tbody>
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Sort by date Sort by votes
This would be the end result of the pivot:

Row LabelsSum of Amount%
Ford$200.0010%
HP$300.0015%
IBM$1,500.0075%
Grand Total$2,000.00

<tbody>
</tbody>


ldashev said:
Hi,

Could someone help design a macro to design a pivot based on this piece of data:

The two columns that I need in the pivot are company and amount (but need to adjust number format field to $ sign) and introduce a new field that would reflect the ratio each company represents from gross amount. I will post what I'd like the pivot to look like in the next post.

Date
ID
REf #
Amount
Company
2/27/2017
111
201701
100
IBM
2/27/2017
222
201702
100
HP
2/27/2017
333
201703
500
IBM
2/27/2017
444
201704
200
Ford
2/27/2017
555
201705
300
IBM
2/27/2017
666
201706
600
IBM
2/27/2017
777
201707
200
HP

<tbody>
</tbody>
Click to expand...
 
Upvote 0
I assume the data is in A1 to E whatever row.
Change this to where you want the pivot table
Code: 
TableDestination:="Sheet1!R1C8
Try this
Code: 
Sub creatept()
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R" & lr & "C5", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Sheet1!R1C8", TableName:="PivotTable2", DefaultVersion _
        :=xlPivotTableVersion14
    Sheets("Sheet1").Select
    Cells(1, 8).Select
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Company")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Amount"), "Sum of Amount", xlSum
    Range("I3").Select
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Sum of Amount")
        .NumberFormat = "$#,##0.00"
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Amount"), "%", xlSum
    Range("J3").Select
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("%")
        .Calculation = xlPercentOfTotal
        .NumberFormat = "0%"
    End With
End Sub
 
Upvote 0
Awesome - it works...how would the code change if I were to insert this pivot in a new sheet in front of this one?

Thanks!
 
Upvote 0
This will make a pivot table on a sheet named Pivot. If you want it the sheet named something else you need to change and all the references to the sheet name
Code: 
Sheets.Add.Name = "pivot"

Code: 
Sub pivot()
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
    Sheets.Add.Name = "pivot"
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R" & lr & "C5", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="pivot!R3C1", TableName:="PivotTable5", DefaultVersion _
        :=xlPivotTableVersion14
    Sheets("pivot").Select
    Cells(2, 1).Select
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Company")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
        "PivotTable5").PivotFields("Amount"), "Sum of Amount", xlSum
    Range("B5").Select
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Sum of Amount")
        .NumberFormat = "$#,##0.00"
    End With
    ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
        "PivotTable5").PivotFields("Amount"), "Sum of Amount2", xlSum
    Range("C5").Select
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Sum of Amount2")
        .Calculation = xlPercentOfTotal
        .NumberFormat = "0.00%"
    End With
    ActiveSheet.PivotTables("PivotTable5").PivotFields("Sum of Amount2").Caption = _
        "%"
End Sub
 
Upvote 0
Worked! And hate to do this to you, but one more tiny thing at the end....is there a way to do a sort of the pivot by %, descending?

Thanks!
 
Upvote 0
This should work. if the sheet Pivot already exists this will delete it.
Code: 
Sub pivot()
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Application.DisplayAlerts = False
Dim worksh As Integer
worksh = Application.Sheets.Count
    For x = 1 To worksh
        If Worksheets(x).Name = "pivot" Then
                        Sheets("pivot").Delete
            Exit For
        End If
    Next x
    Sheets.Add.Name = "pivot"
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R" & lr & "C5", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="pivot!R3C1", TableName:="PivotTable5", DefaultVersion _
        :=xlPivotTableVersion14
    Sheets("pivot").Select
    Cells(2, 1).Select
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Company")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
        "PivotTable5").PivotFields("Amount"), "Sum of Amount", xlSum
    Range("B5").Select
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Sum of Amount")
        .NumberFormat = "$#,##0.00"
    End With
    ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
        "PivotTable5").PivotFields("Amount"), "Sum of Amount2", xlSum
    Range("C5").Select
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Sum of Amount2")
        .Calculation = xlPercentOfTotal
        .NumberFormat = "0.00%"
    End With
    ActiveSheet.PivotTables("PivotTable5").PivotFields("Sum of Amount2").Caption = _
        "%"
    ActiveSheet.PivotTables("PivotTable5").PivotFields("Company").AutoSort _
        xlDescending, "%", ActiveSheet.PivotTables("PivotTable5").PivotColumnAxis. _
        PivotLines(2), 1
Application.DisplayAlerts = True
End Sub
 
Upvote 0
Can I make this tougher on you? What if the denominator is a subset of another sheet, let's say Sheet 2:

So instead of the denominator being $2,000, it now becomes $3,000.

This doesn't have to make logical sense, as it doesn't...but I'd like to see those percentages be based on this value

Date
ID
REf #
Amount
Company
2/27/2017
111
201701
100
IBM
2/27/2017
222
201702
100
HP
2/27/2017
333
201703
500
IBM
2/27/2017
444
201704
200
Ford
2/27/2017
555
201705
300
IBM
2/27/2017
666
201706
600
IBM
2/27/2017
777
201707
200
HP
2/28/2017888201708500Saab
2/28/2017999201709500Saab

<tbody>
</tbody>

so the end result would be:


Row LabelsSum of Amount%
Ford$200.006.67%
HP$300.0010.00%
IBM$1,500.0050.00%
Grand Total$2,000.00

<tbody>
</tbody>
 
Upvote 0
As far as I know the pivot table can not use data outside the pivot table. So the % calculations can not be part of the table but a separate calculation next to the table.

Code: 
Sub pivot()
Dim lr As Long
Dim gt As Long
Dim lrg As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Application.DisplayAlerts = False
Dim worksh As Integer
worksh = Application.Sheets.Count
    For x = 1 To worksh
        If Worksheets(x).Name = "pivot" Then
                        Sheets("pivot").Delete
            Exit For
        End If
    Next x
    Sheets.Add.Name = "pivot"
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R" & lr & "C5", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="pivot!R3C1", TableName:="PivotTable5", DefaultVersion _
        :=xlPivotTableVersion14
    Sheets("pivot").Select
    Cells(2, 1).Select
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Company")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
        "PivotTable5").PivotFields("Amount"), "Sum of Amount", xlSum
    Range("B5").Select
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Sum of Amount")
        .NumberFormat = "$#,##0.00"
    End With
    ActiveSheet.PivotTables("PivotTable5").PivotFields("Company").AutoSort _
        xlAsending, "Sum of Amount", ActiveSheet.PivotTables("PivotTable5").PivotColumnAxis. _
        PivotLines(1), 1
lrg = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("pivot").Activate
lrp = Cells(Rows.Count, 1).End(xlUp).Row
gt = Application.WorksheetFunction.Sum(Sheets("Sheet2").Range("D2:D" & lrg))
For i = 4 To lrp - 1
Cells(i, 3) = Cells(i, 2) / gt
Cells(i, 3).NumberFormat = "0.00%"
Next i
     
Application.DisplayAlerts = True
End Sub
 
Upvote 0
Here's the link to my actual file and the macro below...could you take a look and see why it doesn't work?

https://app.box.com/s/n29a1vfj1kcylh69c6w998ah2kr94uzg

sub pivot()
Dim lr As Long
Dim gt As Long
Dim lrg As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Application.DisplayAlerts = False
Dim worksha As Integer
worksha = Application.Sheets.Count
For x = 1 To worksha
If Worksheets(x).Name = "BenePivot" Then
Sheets("BenePivot").Delete
Exit For
End If
Next x
Sheets.Add.Name = "BenePivot"
ActiveWorkbook.PivotCaches.<wbr>Create(SourceType:=xlDatabase, SourceData:= _
"Beneficiary!R1C1:R" & lr & "C5", Version:=<wbr>xlPivotTableVersion14).<wbr>CreatePivotTable _
TableDestination:="BenePivot!<wbr>R3C1", TableName:="PivotTable5", DefaultVersion _
:=xlPivotTableVersion14
Sheets("BenePivot").Select
Cells(2, 1).Select
With ActiveSheet.PivotTables("<wbr>PivotTable5").PivotFields("<wbr>Secondary Orig")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("<wbr>PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields("<wbr>Trxn Amount"), "Sum of Amount", xlSum
Range("B5").Select
With ActiveSheet.PivotTables("<wbr>PivotTable5").PivotFields("Sum of Amount")
.NumberFormat = "$#,##0.00"
End With

ActiveSheet.PivotTables("<wbr>PivotTable5").PivotFields("<wbr>Secondary Orig").AutoSort _
xlAsending, "Sum of Amount", ActiveSheet.PivotTables("<wbr>PivotTable5").PivotColumnAxis. _
PivotLines(1), 1
lrg = Sheets("Date").Cells(Rows.<wbr>Count, 1).End(xlUp).Row
Sheets("BenePivot").Activate
lrp = Cells(Rows.Count, 1).End(xlUp).Row
gt = Application.WorksheetFunction.<wbr>Sum(Sheets("Date").Range("d2:<wbr>d" & lrg))
For i = 4 To lrp - 1
Cells(i, 3) = Cells(i, 2) / gt
Cells(i, 3).NumberFormat = "0.00%"
Next i


End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Excel macro for Remove comma's and spaces from a cell and place the data in different cell
Replies
3
Views
925
JEC
JEC
T
  • Question
Excel VBA Pivot Table and Graph
Replies
0
Views
456
theworm1810
T
M
  • Question
Create Worksheets based on a table
Replies
5
Views
545
duggie33
D
T
  • Question
filter dynamic data without filter function
Replies
1
Views
2K
Eric W
Eric W
alm395
  • Question
Filter Report based on Dates
Replies
1
Views
617
fadee2
fadee2

Forum statistics

Threads
1,214,919
Messages
6,122,260
Members
449,075
Latest member
staticfluids

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top