Home |
Search |
Today's Posts |
#1
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Creating multiple pivot table report at run time | Excel Programming | |||
Pivot Table from multiple sheets? | Excel Discussion (Misc queries) | |||
Creating Multiple Charts from Same Pivot Table using macro | Excel Programming | |||
Pivot Table from multiple sheets | Excel Discussion (Misc queries) | |||
multiple sheets into 1 pivot table | Excel Programming |