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
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