ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Creating Pivot Table with Macro using Multiple Sheets (https://www.excelbanter.com/excel-discussion-misc-queries/447596-creating-pivot-table-macro-using-multiple-sheets.html)

abbruno

Creating Pivot Table with Macro using Multiple Sheets
 
I have a macro that takes data on the active sheet and then formats it the way I would like to view it in a pivot table. I am trying to do this on multiple worksheets.

When I create the first pivot table, it works perfectly. However, if I choose another worksheet and run the macro, it formats the data correctly, but when it creates the pivot table, it uses the range of data from the first worksheet. Can anyone tell me how to update this code to update the range as I begin creating pivot tables on other 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,1 4,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:=xlDa tabase, SourceData:= _
"=myRange", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="", TableName:="PivotTable3", DefaultVersion _
:=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 d 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").DataPivotFi eld.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").GrandTotalN ame = _
"Rocky Mountain Region Total"
Range("A5").Select
ActiveSheet.PivotTables("PivotTable3").RowAxisLayo ut 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


All times are GMT +1. The time now is 09:19 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com