Creating Pivot Table with Macro using Multiple Sheets

A

abbruno

I have a macro that takes data on the active sheet and then formats i
the way I would like to view it in a pivot table. I am trying to d
this on multiple worksheets.

When I create the first pivot table, it works perfectly. However, if
choose another worksheet and run the macro, it formats the dat
correctly, but when it creates the pivot table, it uses the range o
data from the first worksheet. Can anyone tell me how to update thi
code to update the range as I begin creating pivot tables on othe
worksheets?

Sub Format_For_Pivot()

' Macro3 Macro
'
Rows("2:2").Select
Selection.Delete Shift:=xlUp
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Range("D1").Select
ActiveCell.FormulaR1C1 = "District"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=0,"
"",VLOOKUP(RC[-1],ORG,3,FALSE))"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D10000")
Type:=xlFillDefault
Range("D2:D10000").Select
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Range("E1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-4]=0,"" ""
IF(RC[-4]=""02"",-RC[1],RC[1]))"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E10000")
Type:=xlFillDefault
Range("E2:E10000").Select
ActiveWindow.ScrollRow = 1
Range("E2").Select
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Range("G1").Select
ActiveCell.FormulaR1C1 = "Vendor Unformatted"
Range("G2").Select
ActiveCell.FormulaR1C1
"=IF(RC[1]=0,"""",IF(LEFT(RC[1],4)=""UBUY"",MID(RC[1],FIND("":"",RC[1],1)+1,15),IF(LEFT(RC[1],4)=""GTTE"",MID(RC[1],14,35),RC[1])))"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G10000")
Type:=xlFillDefault
Range("G2:G10000").Select
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Range("H2").Select
ActiveCell.FormulaR1C1 = _

"=IFERROR(SUBSTITUTE(RC[-1],LOOKUP(9.99999999999999E+307,--MID(RC[-1],MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},RC[-1]&""0123456789"")),{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15})),""""),RC[-1])"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Vendor"
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H10000")
Type:=xlFillDefault
Range("H2:H10000").Select
ActiveWindow.ScrollRow = 1
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Rows(LastRow + 1 & ":" & Rows.Count).ClearContents
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Set rng1 = Cells.Find("*", [a1], , , xlByRows, xlPrevious)
Set rng2 = Cells.Find("*", [a1], , , xlByColumns, xlPrevious)
If Not rng1 Is Nothing Then
Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))
Application.Goto rng3
Else
MsgBox "sheet is blank", vbCritical
End If

ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion,
xlYes).Name _
= "myRange"
ActiveSheet.ListObjects("myRange").TableStyle = ""
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:
_
"=myRange", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="", TableName:="PivotTable3", DefaultVersio
_
:=xlPivotTableVersion14
Sheets(ActiveSheet.Name).Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable3").PivotFields("District")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable3").AddDataFiel
ActiveSheet.PivotTables( _
"PivotTable3").PivotFields("Amount"), "Sum of Amount", xlSum
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Vendor")
.Orientation = xlRowField
.Position = 2
End With
Range("B3").Select
ActiveSheet.PivotTables("PivotTable3").DataPivotField.PivotItems( _
"Sum of Amount").Caption = "Total Expense"
Range("B4").Select
ActiveSheet.PivotTables("PivotTable3").TableStyle2
"PivotStyleMedium9"
Columns("B:B").Select
Selection.Style = "Comma"
Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(
""-""??_);_(@_)"
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("A1:C1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = "Rocky Mountain Printing, Stationery &
Supplies"
Range("A2").Select
Range("A1:C1").Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
ActiveWindow.SmallScroll Down:=72
Range("A89").Select
ActiveSheet.PivotTables("PivotTable3").GrandTotalName = _
"Rocky Mountain Region Total"
Range("A5").Select
ActiveSheet.PivotTables("PivotTable3").RowAxisLayout xlTabularRow
Range("A1:C" & LastRow).Select
With ActiveSheet
.PageSetup.PrintArea = .Range("A3").CurrentRegion.Address
End With
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$2"
.PrintTitleColumns = ""
End With
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Range("A1").Select
Application.PrintCommunication = False
Columns("A:A").EntireColumn.AutoFit

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro 3
Macro Loop 1
Macro - very slow run in 2003 3
moving all data to cell a1 2
Modify range in VBA 9
Hard reference in a macro 1
VBA Pivot Table Error 1
Replace a fixed number with a variable via popup 3

Top