Copy data based on pivot table

[DeanP]

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]

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]

Thank you - this has been very helpful

[Paul_Hossler]

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