PDA

View Full Version : Extracting data from pivot table



faye
11-26-2005, 10:56 PM
Hi all, I?m having some doubts about some codes that I produce. Apparently, I am extracting figures from a particular pivot table by coping and pasting the selected range.

My code seems to be too rigid and will definitely go haywire when there?s a change in the pivot table or in the targeted sheet to paste the data (inserting a new row or column). So I need some help to make my Macro more flexible and bulletproof. This will be a little confusing.:think:

I only need to extract one line of data for each region for demand code ?SA? However, I will have to extract 7 lines of data for Demand Code ?TR? for each region. Moreover, there?s position spacing for each data to be pasted is different for each Demand Code.

Thanks in advance.:)


Dim rng As Range
Dim wb As Workbook
Dim path As String
Dim sh As String
Dim col As String
Dim space As Integer
space = 4

ReDim regionArray(5)
regionArray(0) = "Denmark"
regionArray(1) = "USA"
regionArray(2) = "Japan"
regionArray(3) = "Italy"
regionArray(4) = "Germany"
regionArray(5) = "France"

Application.ScreenUpdating = False

path = "D:\My files\Sales.xls"
sh = "Sheet1"

Set wb = Workbooks.Open(path, True, False)
On Error GoTo info

'INITIALISING THE PIVOT TABLE
With wb.Worksheets(sh).PivotTables("PivotTable1")
.PivotFields("Product").Orientation = xlRowField
.PivotFields("Region Code").Orientation = xlPageField
.PivotFields("Demand Code").Orientation = xlPageField
.PivotFields("Product Family").Orientation = xlPageField
.PivotFields("Product Group").Orientation = xlPageField

.PivotFields("Demand Code").CurrentPage = "SA"
.PivotFields("Region Name").CurrentPage = "All"
.PivotFields("Product Technology").CurrentPage = "All"
.PivotFields("Product Family").CurrentPage = "All"
.PivotFields("Product Group").CurrentPage = "V3 T4"
End With

'CODES FOR DEMAND CODE "SA"
Dim j As Integer
Dim startPos As Integer
startPos = 1

For j = 0 To 5 Step 1
wb.Worksheets(sh).PivotTables("PivotTable1").PivotFields("Region Code"). _
CurrentPage = regionArray(j)

If regionArray(j) = "Japan" Then

Set rng = wb.Worksheets(sh).Range("B23:S23")
rng.Copy _
Range(col & startPos).PasteSpecial(xlPasteValues)


startPos = startPos + space
Set rng = wb.Worksheets(sh).Range("B9:S9")

rng.Copy _
Range(col & startPos).PasteSpecial(xlPasteValues)
startPos = startPos + space

ElseIf j = 5 Then

Set rng = wb.Worksheets(sh).Range("B10:S10")
rng.Copy _
Range(col & startPos).PasteSpecial(xlPasteValues)
startPos = startPos + space
Else

Set rng = wb.Worksheets(sh).Range("B9:S9")
rng.Copy _
Range(col & startPos).PasteSpecial(xlPasteValues)
startPos = startPos + space

End If
Next

' CODES FOR DEMAND CODE "TR"

wb.Worksheets(sh).PivotTables("PivotTable1").PivotFields("Demand Type Code"). _
CurrentPage = "TR"
'************************************************************************** **********
Dim rng As Range
Dim i As Integer
Dim startPos2 As Integer
i = 9
startPos2 = 133

wb.Worksheets(sh).PivotTables("PivotTable1").PivotFields("Region Name"). _
CurrentPage = "Denmark"

For i = 9 To 14 Step 1
Set rng = wb.Worksheets(sh).Range("B" & i & ":" & "S" & i)
rng.Copy _
Destination:=Range(col & startPos2)
startPos2 = startPos2 + 4
Next

??.Continued

wb.Close False
Set wb = Nothing
MsgBox "Pivot data retrived from " & path & sh & "."", vbInformation"
Application.ScreenUpdating = True

info:
MsgBox "Source file not found", vbExclamation, "File Referncing Error"
Exit Sub

End Sub