1004 problem with ActiveWorkbook.PivotCaches.Add

J

Jim Snyder

New Member
Joined
Sep 25, 2009
Messages
24
I am trying to build a macro to be placed in a blank spreadsheet for use as a template. My development platform is Excel 2003 on Windows XP SP2. The script was initially recorded as a macro against a single data file with absolute range references and worked both on my develpment platform and on the production platform (Excel 2000 on Windows 2000). However, I have been having fits trying to convert it to dynamic addressing for the PivotCaches.Add. I develop Excel solutions a few times a year and this pivot table is the deepest I have dug into OLE code, so I am not an expert and could have a simple problem. I included the entire macro because I am unsure if there are sideeffects to what some of it is doing. I am getting a 1004 error "The PivotTable field is not valid. To create a PivotTable report, you must use data that is organized as a list with labeled columns. If you are changing the name of a PivotTable field, you must type a new name for the field."

Since I do not get this error with the absolute references, I am puzzled as to what to fix. That is another reason for supplying the entire macro:

Sub PivotMacro()
'
' PivotMacro Macro
' Macro recorded 7/14/2009 by Jim Snyder
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\temp-16000000\TestFile.txt", _
Destination:=Range("A1"))
.FillAdjacentFormulas = True
.TextFileParseType = xlDelimited
.TextFileOtherDelimiter = "~"
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 2)
.Refresh BackgroundQuery:=False
End With

' Variables for determining current range
Dim DataRows As Long
Dim DataColumns As Long
' Dim PivotTableRange As Range
Dim PivotTableRange As String
Range("A1").Select
Selection.End(xlDown).Select
DataRows = ActiveCell.Row
Range("A1").Select
Selection.End(xlToRight).Select
DataColumns = ActiveCell.Column
' PivotTableRange = "Sheet1!R1C1:R" & Format(DataRows) & "C" & Format(DataColumns)
' PivotTableRange = ("Sheet1").Range("A1").CurrentRegion.Address
PivotTableRange = ActiveSheet.Range("A1").CurrentRegion.Address

Selection.EntireRow.Insert
Range("A1:O1").Select
Selection.NumberFormat = "@"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").Select
ActiveCell.FormulaR1C1 = "Check #"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("B1").Select
ActiveCell.FormulaR1C1 = "Check Date"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("C1").Select
ActiveCell.FormulaR1C1 = "EOB #"
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("D1").Select
ActiveCell.FormulaR1C1 = "From Date"
With ActiveCell.Characters(Start:=1, Length:=9).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("E1").Select
ActiveCell.FormulaR1C1 = "To Date"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("F1").Select
ActiveCell.FormulaR1C1 = "Type"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("G1").Select
ActiveCell.FormulaR1C1 = "Participant"
With ActiveCell.Characters(Start:=1, Length:=11).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("H1").Select
ActiveCell.FormulaR1C1 = "BPA Status"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("I1").Select
ActiveCell.FormulaR1C1 = "Type Code"
With ActiveCell.Characters(Start:=1, Length:=9).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("J1").Select
ActiveCell.FormulaR1C1 = "Plan"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("K1").Select
ActiveCell.FormulaR1C1 = "Member"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("L1").Select
ActiveCell.FormulaR1C1 = "Patient"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("M1").Select
ActiveCell.FormulaR1C1 = "Payee"
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("N1").Select
ActiveCell.FormulaR1C1 = "Check Amount"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("O1").Select
ActiveCell.FormulaR1C1 = "Br #"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Columns("G:G").Select
Selection.ColumnWidth = 12.14
Columns("H:H").ColumnWidth = 7.71
Columns("I:I").ColumnWidth = 7.43
Columns("N:N").ColumnWidth = 9.86
Range("O2").Select
Range([a1].CurrentRegion.Address).Sort Key1:=Range("O2"), Order1:=xlAscending, Key2:= _
Range("H2"), Order2:=xlAscending, Key3:=Range("J2"), Order3:=xlAscending _
, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
PivotTableRange).CreatePivotTable TableDestination:="", TableName:= _
"SumPivotTable"
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Br #")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("BPA Status")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Type Code")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Plan")
.Orientation = xlRowField
.Position = 4
End With
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Check Amount")
.Orientation = xlDataField
End With
Range("C6").Select
Selection.Delete
Range("B6").Select
Selection.Delete
Sheets("Sheet1").Select
Range([a1].CurrentRegion.Address).Select
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("A:A").ColumnWidth = 10
Columns("B:B").ColumnWidth = 10
Columns("C:C").ColumnWidth = 11
Columns("D:D").ColumnWidth = 11
Columns("E:E").ColumnWidth = 9
Columns("F:F").ColumnWidth = 8
Columns("G:G").ColumnWidth = 12
Columns("H:H").ColumnWidth = 8
Columns("I:I").ColumnWidth = 8
Columns("J:J").ColumnWidth = 8
Columns("K:K").ColumnWidth = 26
Columns("L:L").ColumnWidth = 26
Columns("M:M").ColumnWidth = 40
Columns("N:N").ColumnWidth = 10
Columns("N:N").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
Range("M1").Select
Selection.Copy
Range("N1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Concatenated Columns"
With ActiveCell.Characters(Start:=1, Length:=20).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("N2").Select
Selection.Copy
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("N2:N24"), Type:=xlFillDefault
Range("N2:N24").Select
Selection.NumberFormat = "General"
Range("N2").Select
ActiveCell.FormulaR1C1 = "=RC[-6]&RC[-5]&RC[-4]&RC[2]"
Range("N2").Select
Selection.AutoFill Destination:=Range("N2:" & DataRows), Type:=xlFillDefault
Range("N2:" & DataRows).Select
Range("O2").Select
Selection.Subtotal GroupBy:=14, Function:=xlSum, TotalList:=Array(15), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ChDir "C:\temp-16000000"
ActiveWorkbook.SaveAs Filename:= _
"C:\temp-16000000\TestFile.xls", FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
 
Sort by date Sort by votes
Sorry for the multiple replies, but MrExcel was hung for a while. Here are some of the variable results just before failure:

Code: 
?Range("A1").CurrentRegion.Name
=Sheet1!$A$1:$P$1684
?PC.SourceType
 1 
?PC.SourceData
DataSource

It shows that the name of the current region is translated for spitting the range back out, but only the name is returned when I look at SourceData. That may be the way it should be, though.
 
Upvote 0
I tried a solution found in another Excel forum. The person had a similar problem to mine and replaced the PivotCaches.Add with the PivotTableWizard. Credit goes to Tom Ogilvie:

Code: 
Sub PivotMacro()
'
' PivotMacro Macro
' Macro recorded 7/14/2009 by Jim Snyder
'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\temp-16000000\TestFile.txt", _
        Destination:=Range("A1"))
        .FillAdjacentFormulas = True
        .TextFileParseType = xlDelimited
        .TextFileOtherDelimiter = "~"
        .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 2)
        .Refresh BackgroundQuery:=False
    End With
 
    ' Variables for determining current range
    Dim DataRows As Long
    Dim DataColumns As Long
 
    Range("A1").Select
    Selection.End(xlDown).Select
    DataRows = ActiveCell.Row
    Range("A1").Select
    Selection.End(xlToRight).Select
    DataColumns = ActiveCell.Column
 
    ' Named Range
    ' Range("A1").Select
    ' Selection.CurrentRegion.Select
    ' Selection.Name = "DataSource"
 
    ' String
    ' Dim PivotTableRange As Range
    Dim PivotTableRange As String
    ' PivotTableRange = "Sheet1!R1C1:R" & Format(DataRows) & "C" & Format(DataColumns)
    ' PivotTableRange = ("Sheet1").Range("A1").CurrentRegion.Address
    PivotTableRange = "Sheet1!" & ActiveSheet.Range("A1").CurrentRegion.Address
    Selection.EntireRow.Insert
    With Range("A1:O1")
        .NumberFormat = "@"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        With .Font
            .Name = "Century Gothic"
            .FontStyle = "Bold"
            .Size = 11
        End With
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
    Range("A1:O1").Value = Array("Check #", "Check Date", "EOB #", "From Date", "To Date", "Type", "Participant", _
                              "BPA Status", "Type Code", "Plan", "Member", "Patient", "Payee", "Check Amount", "Br #")
    Columns("G:G").ColumnWidth = 12.14
    Columns("H:H").ColumnWidth = 7.71
    Columns("I:I").ColumnWidth = 7.43
    Columns("N:N").ColumnWidth = 9.86
    Range("O2").Select
    Range([a1].CurrentRegion.Address).Sort Key1:=Range("O2"), Order1:=xlAscending, Key2:= _
        Range("H2"), Order2:=xlAscending, Key3:=Range("J2"), Order3:=xlAscending _
        , Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
        xlTopToBottom
 
    ' Wizard
[COLOR=green]   Worksheets(Sheet1).PivotTableWizard _[/COLOR]
[COLOR=green]   SourceType:=xlDatabase, _[/COLOR]
[COLOR=green]   SourceData:=PivotTableRange, _[/COLOR]
[COLOR=green]   TableDestination:="", _[/COLOR]
[COLOR=green]   TableName:="SumPivotTable", _[/COLOR]
[COLOR=green]   DefaultVersion:=xlPivotTableVersion10[/COLOR]
        
    ' Named Range
    ' ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "DataSource").CreatePivotTable TableDestination:="", TableName:= _
        "SumPivotTable", DefaultVersion:=xlPivotTableVersion10
 
    ' Selection
    ' Range([a1].CurrentRegion.Address).Select
    ' ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        Selection.CurrentRegion).CreatePivotTable TableDestination:="", TableName:= _
        "SumPivotTable", DefaultVersion:=xlPivotTableVersion10
 
    ' String
    ' ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        PivotTableRange).CreatePivotTable TableDestination:="", TableName:= _
        "SumPivotTable", DefaultVersion:=xlPivotTableVersion10
 
    ' Absolute referenced range
    ' ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R1684C15").CreatePivotTable TableDestination:="", TableName:= _
        "SumPivotTable", DefaultVersion:=xlPivotTableVersion10
 
 
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Br #")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("SumPivotTable").PivotFields("BPA Status")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Type Code")
        .Orientation = xlRowField
        .Position = 3
    End With
    With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Plan")
        .Orientation = xlRowField
        .Position = 4
    End With
    With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Check Amount")
        .Orientation = xlDataField
    End With
    Range("C6").Select
    Selection.Delete
    Range("B6").Select
    Selection.Delete
    Sheets("Sheet1").Select
    Range([a1].CurrentRegion.Address).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Columns("A:A").ColumnWidth = 10
    Columns("B:B").ColumnWidth = 10
    Columns("C:C").ColumnWidth = 11
    Columns("D:D").ColumnWidth = 11
    Columns("E:E").ColumnWidth = 9
    Columns("F:F").ColumnWidth = 8
    Columns("G:G").ColumnWidth = 12
    Columns("H:H").ColumnWidth = 8
    Columns("I:I").ColumnWidth = 8
    Columns("J:J").ColumnWidth = 8
    Columns("K:K").ColumnWidth = 26
    Columns("L:L").ColumnWidth = 26
    Columns("M:M").ColumnWidth = 40
    Columns("N:N").ColumnWidth = 10
    Columns("N:N").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight
    Range("M1").Select
    Selection.Copy
    Range("N1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Concatenated Columns"
    With ActiveCell.Characters(Start:=1, Length:=20).Font
        .Name = "Century Gothic"
        .FontStyle = "Bold"
        .Size = 11
    End With
    Range("N2").Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("N2:N24"), Type:=xlFillDefault
    Range("N2:N24").Select
    Selection.NumberFormat = "General"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=RC[-6]&RC[-5]&RC[-4]&RC[2]"
    Range("N2").Select
    Selection.AutoFill Destination:=Range("N2:N" & DataRows), Type:=xlFillDefault
    Range("N2:N" & DataRows).Select
    Range("O2").Select
    Selection.Subtotal GroupBy:=14, Function:=xlSum, TotalList:=Array(15), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ChDir "C:\temp-16000000"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\temp-16000000\TestFile.xls", FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
End Sub

I do not know if I regressed or progressed, but the error is now "Run-time error '13': Type mismatch". I will resume in the morning when I am fresher.
 
Upvote 0
I've just tested the code I posted using your actual headers and some dummy data and it runs fine, so there doesn't appear to be anything syntactically wrong. Can you post the text file somewhere or email it, so I can try to rule that out as the cause?
 
Upvote 0
Unfortunately, no. It is client information and covered by HIPAA regulations. The best I could do is to characterize the data that is in the fields so that similar data could be fabricated.
 
Upvote 0
We only need about 10 rows of data and you could simply overwrite any identifying information? (e.g. replace names or SSNs with "dummy")
 
Upvote 0
I am working on it now. I am using sequences of 1234567890 to replace PHI (private health information) information. I seem to only be able to connect to MrExcel sporatically, so although I may have a file in about half an hour, it may take longer to post it. Something must be roiling the big pond...
 
Upvote 0
Since you can't post it here, I'll PM you an email address if that's OK?
 
Upvote 0
I, too, ran perfectly with the generated test file, but failed on the production data. I will be working on figuring out the difference. For any who have been lurking, I am posting the working script below:

Code: 
Sub PivotMacro()
'
' PivotMacro Macro
' Macro recorded 7/14/2009 by Jim Snyder
'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\temp-16000000\TestFile.txt", _
        Destination:=Range("A1"))
        .FillAdjacentFormulas = True
        .TextFileParseType = xlDelimited
        .TextFileOtherDelimiter = "~"
        .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 2)
        .Refresh BackgroundQuery:=False
    End With
    
    ' Variables for determining current range
    Dim DataRows As Long
    Dim DataColumns As Long
    
    Range("A1").Select
    Selection.End(xlDown).Select
    DataRows = ActiveCell.Row
    Range("A1").Select
    Selection.End(xlToRight).Select
    DataColumns = ActiveCell.Column
    
    ' Named Range
    ' Range("A1").Select
    ' Selection.CurrentRegion.Select
    ' Selection.Name = "DataSource"
    
    ' String
    ' Dim PivotTableRange As Range
    Dim PivotTableRange As String
    ' PivotTableRange = "Sheet1!R1C1:R" & Format(DataRows) & "C" & Format(DataColumns)
    ' PivotTableRange = ("Sheet1").Range("A1").CurrentRegion.Address
    PivotTableRange = "Sheet1!" & ActiveSheet.Range("A1").CurrentRegion.Address
    Selection.EntireRow.Insert
    With Range("A1:O1")
        .NumberFormat = "@"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        With .Font
            .Name = "Century Gothic"
            .FontStyle = "Bold"
            .Size = 11
        End With
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
    Range("A1:O1").Value = Array("Check #", "Check Date", "EOB #", "From Date", "To Date", "Type", "Participant", _
                              "BPA Status", "Type Code", "Plan", "Member", "Patient", "Payee", "Check Amount", "Br #")
    Columns("G:G").ColumnWidth = 12.14
    Columns("H:H").ColumnWidth = 7.71
    Columns("I:I").ColumnWidth = 7.43
    Columns("N:N").ColumnWidth = 9.86
    Range("O2").Select
    Range([a1].CurrentRegion.Address).Sort Key1:=Range("O2"), Order1:=xlAscending, Key2:= _
        Range("H2"), Order2:=xlAscending, Key3:=Range("J2"), Order3:=xlAscending _
        , Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
        xlTopToBottom
        
    ' Wizard
    ' Worksheets(Sheet1).PivotTableWizard _
    ' SourceType:=xlDatabase, _
    ' SourceData:=PivotTableRange, _
    ' TableDestination:="", _
    ' TableName:="SumPivotTable", _
    ' DefaultVersion:=xlPivotTableVersion10
        
    ' Named Range
    ' ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "DataSource").CreatePivotTable TableDestination:="", TableName:= _
        "SumPivotTable", DefaultVersion:=xlPivotTableVersion10
        
    ' Selection
    ' Range([a1].CurrentRegion.Address).Select
    ' ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        Selection.CurrentRegion).CreatePivotTable TableDestination:="", TableName:= _
        "SumPivotTable", DefaultVersion:=xlPivotTableVersion10
        
    ' String
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        PivotTableRange).CreatePivotTable TableDestination:="", TableName:= _
        "SumPivotTable", DefaultVersion:=xlPivotTableVersion10
        
    ' Absolute referenced range
    ' ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R1684C15").CreatePivotTable TableDestination:="", TableName:= _
        "SumPivotTable", DefaultVersion:=xlPivotTableVersion10
        
        
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Br #")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("SumPivotTable").PivotFields("BPA Status")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Type Code")
        .Orientation = xlRowField
        .Position = 3
    End With
    With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Plan")
        .Orientation = xlRowField
        .Position = 4
    End With
    With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Check Amount")
        .Orientation = xlDataField
    End With
    Range("C6").Select
    Selection.Delete
    Range("B6").Select
    Selection.Delete
    Sheets("Sheet1").Select
    Range([a1].CurrentRegion.Address).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Columns("A:A").ColumnWidth = 10
    Columns("B:B").ColumnWidth = 10
    Columns("C:C").ColumnWidth = 11
    Columns("D:D").ColumnWidth = 11
    Columns("E:E").ColumnWidth = 9
    Columns("F:F").ColumnWidth = 8
    Columns("G:G").ColumnWidth = 12
    Columns("H:H").ColumnWidth = 8
    Columns("I:I").ColumnWidth = 8
    Columns("J:J").ColumnWidth = 8
    Columns("K:K").ColumnWidth = 26
    Columns("L:L").ColumnWidth = 26
    Columns("M:M").ColumnWidth = 40
    Columns("N:N").ColumnWidth = 10
    Columns("N:N").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight
    Range("M1").Select
    Selection.Copy
    Range("N1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Concatenated Columns"
    With ActiveCell.Characters(Start:=1, Length:=20).Font
        .Name = "Century Gothic"
        .FontStyle = "Bold"
        .Size = 11
    End With
    Range("N2").Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("N2:N24"), Type:=xlFillDefault
    Range("N2:N24").Select
    Selection.NumberFormat = "General"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=RC[-6]&RC[-5]&RC[-4]&RC[2]"
    Range("N2").Select
    Selection.AutoFill Destination:=Range("N2:N" & DataRows), Type:=xlFillDefault
    Range("N2:N" & DataRows).Select
    Range("O2").Select
    Selection.Subtotal GroupBy:=14, Function:=xlSum, TotalList:=Array(15), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ChDir "C:\temp-16000000"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\temp-16000000\TestFile.xls", FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Copy Picture - VBA
2
Replies
10
Views
524
Logit
Logit
I
  • Question Question
Advice for Could Not Find The Specific Object message
2
Replies
12
Views
244
ipbr21054
I
A
  • Solved
Sum values and divided into textboxes on form based on showing data in listbox
Replies
9
Views
87
Anthony47
A
W
  • Question Question
Run-time error '1004': Application-defined or object-defined error While searching for shapes within a specified area in worksheet using VBA.
Replies
7
Views
102
NdNoviceHlp
NdNoviceHlp
I
  • Solved
Date formula not applied the same to all Listbox entries
Replies
2
Views
104
ipbr21054
I

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top