PDA

View Full Version : [SOLVED:] Copy data based on pivot table



DeanP
01-16-2019, 06:14 PM
I need a vba solution to create a report using 2 data sources, a spreadsheet and a pivot table. I've attached sample data
in the attachment.
I have a 3rd summary sheet "Allocation" with headings (refer attachment)
In the worksheet "Split" I have a spreadsheet listing a bunch of cost centres (Col. A & B) and 4 reporting segments. They
are represented by C1, D1, E1 & F1. The rest of the table contains percentage values by reporting segment for each of my
cost centres.
In the worksheet "Pivot" I have a pivot table with ledger codes (Col A), the same 4 reporting segments, and a corresponding
value for each ledger code per reporting segment.
I need to do the following:
Clear the contents of the "Allocation" worksheet (retain rows 1 & 2 and formatting). Starting at A3, G3, M3 & S3
respectively, copy:
(a) from the pivot table, for each segment, copy to another worksheet ("Allocation") the ledger code (col A) and it's
value (col B) where the value in column B is greater than zero. Copy the value of the pivot table code in col A for
each of the segments in the "Allocation" sheet in B3, H3, N3 & T3
(b) then for each ledger code copied I need to create duplicate rows equal to the number of cost center codes in "Split"
where the value in the segment column is not zero. The cost centre codes in col A & B should be copied to the sheet.
The "Allocation" sheet is a representation of what the resulting report should look like.
I have been researching how to do this, but cannot find anything useful. Would appreciate if someone can point me in the
right direction to start this project.

werafa
01-28-2019, 02:18 AM
Hi,

to start, each individual step should be an individual vba coding subroutine (or group of subs)
eg, step 1: clear old contents.
step 2: copy ledger codes and values
step three: where ledger value fails test, overwrite with alternate value

etc.

Write it out in logic like this before you start any coding.

I think you will find using objects helpful.
google "excel VBA range objects" and "excel vba worksheet objects"
you may also need to read up on "Excel vba rows.insert"

Pivot table objects are a bit more complex, and you might need to come back here for specific help once you hit this bit



This should at least help you get down to specific, detailed questions, and with luck will actually get you started on the code you are looking for

regards
Werafa

DeanP
02-08-2019, 06:16 AM
Thank you - this has been very helpful

Paul_Hossler
02-08-2019, 10:20 AM
I'd start with something like this




Option Explicit

Dim rSplit As Range, rPivot As Range
Dim ws As Worksheet
Sub AllocationReport()

'set up
Application.ScreenUpdating = False
Set rSplit = Worksheets("Split").Cells(1, 1).CurrentRegion
Set rPivot = Worksheets("Pivot").Cells(1, 1).CurrentRegion
Set ws = Worksheets("Allocation")

'clear old
With ws
Range(.Rows(3), .Rows(.Rows.Count)).Clear
End With
' Column numbers
' 1 2 3 4 5 6
' Split Cost Cen BS Vol Spc Asm Ssh
' 1 2 3 4 5 6
' Pivot Nom Vol Spc Asm Ssh Grand Total
' 1 7 13 19
' Alloc SPC VOL ASM SSH
Call pvtMove(4, 3, 1) ' SPC
Call pvtMove(3, 2, 7) ' VOL
Call pvtMove(5, 4, 13) ' ASM
Call pvtMove(6, 5, 19) ' SHH

'cleanup
Application.ScreenUpdating = True

End Sub

Private Sub pvtMove(colSplit As Long, colPivot As Long, colAlloc As Long)
Dim iOut As Long, iSplit As Long, iPivot As Long

iOut = 3
With ws
For iPivot = 2 To rPivot.Rows.Count

If rPivot.Cells(iPivot, colPivot).Value = 0 Then GoTo NextiPivot

.Cells(iOut, colAlloc).Value = rPivot.Cells(iPivot, 1).Value
.Cells(iOut, colAlloc + 1).Value = rPivot.Cells(iPivot, colPivot).Value

For iSplit = 2 To rSplit.Rows.Count
If rSplit.Cells(iSplit, colSplit).Value = 0 Then GoTo NextiSplit

.Cells(iOut, colAlloc).Value = rPivot.Cells(iPivot, 1).Value
.Cells(iOut, colAlloc + 2).Value = Round(rSplit.Cells(iSplit, 1).Value, 2)
.Cells(iOut, colAlloc + 3).Value = "'" & rSplit.Cells(iSplit, 2).Text
.Cells(iOut, colAlloc + 4).Value = Round(rSplit.Cells(iSplit, colSplit).Value, 2)
iOut = iOut + 1
NextiSplit:
Next iSplit
NextiPivot:
Next iPivot

End With
End Sub