Pivot Totals
My stamp club has an auction a couple times a month and I noticed our treaurer was struggling to figure out what each person owed and what the stakeholders should receive.I wrote a little ditty that with the click of one icon in my ribbon, it builds 2 pivot tables side-by-side. One shows what each of the buyers owe and the other figures the totals for the Owner; less some handling fees.
Quo = Chr(34)
'---------------------------- Build Accting Totals -------------------- 12-03-2022
Cells.Find(What:="Sum of Hammer", After:=ActiveCell, LookIn:=xlFormulas2 _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate 'Find Starting
HamrCol = ActiveCell.Column + 1
HamrRow = ActiveCell.Row
Cells.Find(What:="Grand Total", After:=Cells(55, HamrCol - 2), LookIn:=xlFormulas2 _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate 'Find Starting
FrtTot = ActiveCell.Row + 1
For Z = HamrCol To HamrCol + 5
On Error GoTo NoMore
Cells(FrtTot, Z) = "=GETPIVOTDATA(" & Quo & "HAMMER" & Quo & "," & _
Cells(1, HamrCol - 1).Address & "," & Quo & "OWNER" & Quo & "," & Cells(HamrRow + 1, Z) & _
")*0.05"
Cells(FrtTot + 1, Z) = Cells(FrtTot, Z)
'"=GETPIVOTDATA(" & Quo & "HAMMER" & Quo & "," & Quo & _
Cells(1, HamrCol - 1).Address & Quo & "," & Quo & "OWNER" & Quo & "," & _
Cells(HamrRow + 1, Z) & ")*0.05"
Cells(FrtTot + 2, Z) = "=GETPIVOTDATA(" & Quo & "HAMMER" & Quo & "," & _
Cells(1, HamrCol - 1).Address & "," & Quo & "OWNER" & Quo & "," & _
Cells(HamrRow + 1, Z) & ")-(" & Cells(FrtTot + 1, Z) + Cells(FrtTot + 2) & ")"
Cells(FrtTot + 3, Z) = "Owner " & Cells(HamrRow + 1, Z)
Next Z
This section of the VBA code show how I am handling the accounting for the Owners/Sellers. In this case, our auction writer gets 5%, the club takes 5%, and the owner gets the balance.
|