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").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("D210000")
Type:=xlFillDefault
Range("D210000").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
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").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("D210000")
Type:=xlFillDefault
Range("D210000").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