VBA Pivot Table run-time 1004 error PivotCache line help

V

vikem

New Member
Joined
Sep 2, 2015
Messages
23
Hello, I'm working on code that allows me to pick a file, and create 2 separate pivot tables off 2 separate worksheets from the file and updating additional worksheets with pivot table data and then repeating a second time with a 2nd file. When putting the code together separately and testing one part at a time I was able to create pivot tables just fine. Now that I've combined the code into one module I keep getting the following error from this line of code
Code: 
Set pt = ActiveSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=Range("A1"), TableName:="PivotTable1")
I'm also not able to create them separately now any longer.

The prompt I receive is this: Run-time error ‘1004’: The PivotTable field name 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.

I've tried searching this but cannot find something that can help me fix my problem.

Complete code is below. Thanks in advance for any help you can provide. Hope this is something simple. I'm running Excel 2010 on Windows 7.

Code: 
Sub RunAllMacros()
 Pickfile
 FD20Pivot1
 FD20Pivot2
 Pickfile2
 ND2APivot1
 ND2APivot2
End Sub


Sub Pickfile()

'Sets file types to display in file picker (this example is set for .xls files
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.xlsx), *.xlsx", _
      MultiSelect:=True, Title:="Workbook(s) to open")

'Section to enable file picker
   If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        Exit Sub
    End If
    x = 1
    While x <= UBound(FilesToOpen)
    Application.DisplayAlerts = False
        Workbooks.Open Filename:=FilesToOpen(x)
        x = x + 1
        
'Records selected workbooks name
thiswb = ActiveWorkbook.Name

'activate a workbook by stored variable name
Workbooks(thiswb).Activate

Wend

End Sub

Sub FD20Pivot1()

'creates FD20 DEF pivot table

Dim PCache As PivotCache, LastRow As Long, pt As PivotTable

 Worksheets("DEF Data").Activate
 Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=1, SourceData:=Range("A1").CurrentRegion.Address)
     Worksheets.Add
    ActiveSheet.Name = "Sheet 1"
    ActiveWindow.DisplayGridlines = False
 Set pt = ActiveSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=Range("A1"), TableName:="PivotTable1")
     
 'Select fields for PivotTable
     ActiveWorkbook.ShowPivotTableFieldList = True
    
     With pt.PivotFields("Status")
         .Orientation = xlRowField
         .Position = 1
     End With
     With pt.PivotFields("GROUP")
         .Orientation = xlRowField
         .Position = 2
     End With
     pt.AddDataField pt.PivotFields("STAT"), "Count of STAT", xlCount
     With pt.PivotFields("Count of STAT")
         .Caption = "Count of STAT"
         .Function = xlCount
     End With
     pt.AddDataField pt.PivotFields("Amount"), "Sum of Amount", xlCount
     With pt.PivotFields("Sum of Amount")
         .Caption = "Sum of Amount"
         .Function = xlSum
     End With
     pt.AddDataField pt.PivotFields("Absolute"), "Sum of Absolute", xlCount
     With pt.PivotFields("Sum of Absolute")
         .Caption = "Sum of Absolute"
         .Function = xlSum
     End With
     ActiveWorkbook.ShowPivotTableFieldList = False
     ActiveSheet.Name = "DEFPivot"
     Rows("1:2").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     
'DEF status 1 calculation to report
    ActiveSheet.PivotTables("PivotTable1").PivotFields("STATUS").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("STATUS").CurrentPage = "1"
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "DEFPivot"
    Sheets("DEF Report").Select
    Range("A9:E20").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    ActiveSheet.Name = "Sheet2"
    Range("A1").Select
    Application.CutCopyMode = False
    Range("A2").Select
    Sheets("DEF Report").Select
    Range("A23:E34").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    ActiveSheet.Name = "Sheet3"
    Range("A1").Select
    Application.CutCopyMode = False
    Range("A2").Select
    Sheets("Sheet2").Select
    Range("A1").Select
       
    Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 1).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C2:R20000C2,MATCH(RC[-1],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 1).Copy
            Cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next

    Columns("C:C").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 2).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C3:R20000C3,MATCH(RC[-2],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 2).Copy
            Cell.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("D:D").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
         Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 3).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C4:R20000C4,MATCH(RC[-3],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 3).Copy
            Cell.Offset(0, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("E:E").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Range("A1:E12").Select
    Selection.Copy
    Sheets("DEF Report").Select
    Range("A9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
'DEF status 2 calculation to report
    Sheets("DEFPivot").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("STATUS").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("STATUS").CurrentPage = "2"
    Sheets("Sheet3").Select
          
    Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 1).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C2:R20000C2,MATCH(RC[-1],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 1).Copy
            Cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next

    Columns("C:C").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 2).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C3:R20000C3,MATCH(RC[-2],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 2).Copy
            Cell.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("D:D").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
         Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 3).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C4:R20000C4,MATCH(RC[-3],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 3).Copy
            Cell.Offset(0, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("E:E").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Range("A1:E12").Select
    Selection.Copy
    Sheets("DEF Report").Select
    Range("A23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Sub FD20Pivot2()
 'Reg 6 pivot
    Worksheets("Reg 6 Data").Activate
 Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=1, SourceData:=Range("A1").CurrentRegion.Address)
     Worksheets.Add
    ActiveSheet.Name = "Sheet 4"
    ActiveWindow.DisplayGridlines = False
 Set pt = ActiveSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=Range("A1"), TableName:="PivotTable1")
     
 'Select fields for PivotTable
     ActiveWorkbook.ShowPivotTableFieldList = True
     With pt.PivotFields("GROUP")
         .Orientation = xlRowField
         .Position = 1
     End With
     pt.AddDataField pt.PivotFields("Status Code"), "Count of Status Code", xlCount
     With pt.PivotFields("Count of Status Code")
         .Caption = "Count of Status Code"
         .Function = xlCount
     End With
     pt.AddDataField pt.PivotFields("Amount"), "Sum of Amount", xlCount
     With pt.PivotFields("Sum of Amount")
         .Caption = "Sum of Amount"
         .Function = xlSum
     End With
     pt.AddDataField pt.PivotFields("Absolute"), "Sum of Absolute", xlCount
     With pt.PivotFields("Sum of Absolute")
         .Caption = "Sum of Absolute"
         .Function = xlSum
     End With
     ActiveWorkbook.ShowPivotTableFieldList = False
     ActiveSheet.Name = "REG6Pivot"
     Rows("1:2").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
    
'REG6 calculation to report
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "REG6Pivot"
    Sheets("Reg 6 Report").Select
    Range("B4:E4").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("A4:E15").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    ActiveSheet.Name = "Sheet5"
    Sheets("Sheet5").Select
    Range("A1").Select
    Range("B1:E2").Select
    Selection.Cut
    Range("F1").Select
    ActiveSheet.Paste
       
    Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 1).FormulaR1C1 = _
            "=INDEX(REG6Pivot!R1C2:R10000C2,MATCH(RC[-1],REG6Pivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 1).Copy
            Cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next

    Columns("C:C").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 2).FormulaR1C1 = _
            "=INDEX(REG6Pivot!R1C3:R20000C3,MATCH(RC[-2],REG6Pivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 2).Copy
            Cell.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("D:D").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
         Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 3).FormulaR1C1 = _
            "=INDEX(REG6Pivot!R1C4:R20000C4,MATCH(RC[-3],REG6Pivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 3).Copy
            Cell.Offset(0, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("E:E").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Range("F1:I2").Select
    Selection.Cut
    Range("B1").Select
    ActiveSheet.Paste
            
    Range("A1:E12").Select
    Selection.Copy
    Sheets("Reg 6 Report").Select
    Range("A4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("DEF Report").Select
    Range("C20").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("D20").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E20").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("C34").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("D34").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E34").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Sheets("Reg 6 Report").Select
    Range("C15").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("D15").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E15").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E16").Select
                
    Application.DisplayAlerts = False
    Sheets("Sheet2").Select
    ActiveSheet.Delete
    Sheets("Sheet3").Select
    ActiveSheet.Delete
    Sheets("Sheet5").Select
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Pickfile2()
   
   'Sets file types to display in file picker (this example is set for .xls files
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.xlsx), *.xlsx", _
      MultiSelect:=True, Title:="Workbook(s) to open")

'Section to enable file picker
   If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        Exit Sub
    End If
    x = 1
    While x <= UBound(FilesToOpen)
    Application.DisplayAlerts = False
        Workbooks.Open Filename:=FilesToOpen(x)
        x = x + 1
        
'Records selected workbooks name
thiswb = ActiveWorkbook.Name

'activate a workbook by stored variable name
Workbooks(thiswb).Activate

Wend

End Sub

Sub ND2APivot1()

'creates ND2A DEF pivot table

 Worksheets("DEF Data").Activate
 Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=1, SourceData:=Range("A1").CurrentRegion.Address)
     Worksheets.Add
    ActiveSheet.Name = "Sheet 1"
    ActiveWindow.DisplayGridlines = False
 Set pt = ActiveSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=Range("A1"), TableName:="PivotTable1")
     
 'Select fields for PivotTable
     ActiveWorkbook.ShowPivotTableFieldList = True
    
     With pt.PivotFields("Status")
         .Orientation = xlRowField
         .Position = 1
     End With
     With pt.PivotFields("GROUP")
         .Orientation = xlRowField
         .Position = 2
     End With
     pt.AddDataField pt.PivotFields("STAT"), "Count of STAT", xlCount
     With pt.PivotFields("Count of STAT")
         .Caption = "Count of STAT"
         .Function = xlCount
     End With
     pt.AddDataField pt.PivotFields("Amount"), "Sum of Amount", xlCount
     With pt.PivotFields("Sum of Amount")
         .Caption = "Sum of Amount"
         .Function = xlSum
     End With
     pt.AddDataField pt.PivotFields("Absolute"), "Sum of Absolute", xlCount
     With pt.PivotFields("Sum of Absolute")
         .Caption = "Sum of Absolute"
         .Function = xlSum
     End With
     ActiveWorkbook.ShowPivotTableFieldList = False
     ActiveSheet.Name = "DEFPivot"
     Rows("1:2").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
'DEF status 1 calculation to report
    
    Sheets("DEF Report").Select
    Range("A9:E20").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    ActiveSheet.Name = "Sheet2"
    Range("A1").Select
    Application.CutCopyMode = False
    Range("A2").Select
    Sheets("DEF Report").Select
    Range("A23:E34").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    ActiveSheet.Name = "Sheet3"
    Range("A1").Select
    Application.CutCopyMode = False
    Range("A2").Select
    Sheets("Sheet2").Select
    Range("A1").Select
    
    Sheets("DEFPivot").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Status").ClearAllFilters
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Status")
        .PivotItems("2").Visible = False
    End With
    Sheets("Sheet2").Select
       
    Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 1).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C2:R20000C2,MATCH(RC[-1],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 1).Copy
            Cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next

    Columns("C:C").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 2).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C3:R20000C3,MATCH(RC[-2],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 2).Copy
            Cell.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("D:D").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
         Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 3).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C4:R20000C4,MATCH(RC[-3],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 3).Copy
            Cell.Offset(0, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("E:E").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Range("A1:E12").Select
    Selection.Copy
    Sheets("DEF Report").Select
    Range("A9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
'DEF status 2 calculation to report
    Sheets("DEFPivot").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Status").ClearAllFilters
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Status")
        .PivotItems("1").Visible = False
    End With
    Sheets("Sheet3").Select
          
    Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 1).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C2:R20000C2,MATCH(RC[-1],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 1).Copy
            Cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next

    Columns("C:C").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 2).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C3:R20000C3,MATCH(RC[-2],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 2).Copy
            Cell.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("D:D").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
         Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 3).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C4:R20000C4,MATCH(RC[-3],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 3).Copy
            Cell.Offset(0, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("E:E").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Range("A1:E12").Select
    Selection.Copy
    Sheets("DEF Report").Select
    Range("A23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub
        
Sub ND2APivot2()

'creates ND2A REG6 pivot table

 Worksheets("Reg 6 Data").Activate
 Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=1, SourceData:=Range("A1").CurrentRegion.Address)
     Worksheets.Add
    ActiveSheet.Name = "Sheet 4"
    ActiveWindow.DisplayGridlines = False
 Set pt = ActiveSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=Range("A1"), TableName:="PivotTable1")
     
 'Select fields for PivotTable
     ActiveWorkbook.ShowPivotTableFieldList = True
     With pt.PivotFields("GROUP")
         .Orientation = xlRowField
         .Position = 1
     End With
     pt.AddDataField pt.PivotFields("Status Code"), "Count of Status Code", xlCount
     With pt.PivotFields("Count of Status Code")
         .Caption = "Count of Status Code"
         .Function = xlCount
     End With
     pt.AddDataField pt.PivotFields("Amount"), "Sum of Amount", xlCount
     With pt.PivotFields("Sum of Amount")
         .Caption = "Sum of Amount"
         .Function = xlSum
     End With
     pt.AddDataField pt.PivotFields("Absolute"), "Sum of Absolute", xlCount
     With pt.PivotFields("Sum of Absolute")
         .Caption = "Sum of Absolute"
         .Function = xlSum
     End With
     ActiveWorkbook.ShowPivotTableFieldList = False
     ActiveSheet.Name = "REG6Pivot"
     Rows("1:2").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
'REG6 calculation to report
    Sheets("Reg 6 Report").Select
    Range("B4:E4").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("A4:E15").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    ActiveSheet.Name = "Sheet5"
    Sheets("Sheet5").Select
    Range("A1").Select
    Range("B1:E2").Select
    Selection.Cut
    Range("F1").Select
    ActiveSheet.Paste
       
    Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 1).FormulaR1C1 = _
            "=INDEX(REG6Pivot!R1C2:R10000C2,MATCH(RC[-1],REG6Pivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 1).Copy
            Cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next

    Columns("C:C").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 2).FormulaR1C1 = _
            "=INDEX(REG6Pivot!R1C3:R20000C3,MATCH(RC[-2],REG6Pivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 2).Copy
            Cell.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("D:D").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
         Set Rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 3).FormulaR1C1 = _
            "=INDEX(REG6Pivot!R1C4:R20000C4,MATCH(RC[-3],REG6Pivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set Rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each Cell In Rng
        If Cell.Value <> "" Then
            Cell.Offset(0, 3).Copy
            Cell.Offset(0, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("E:E").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Range("F1:I2").Select
    Selection.Cut
    Range("B1").Select
    ActiveSheet.Paste
            
    Range("A1:E12").Select
    Selection.Copy
    Sheets("Reg 6 Report").Select
    Range("A4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("DEF Report").Select
    Range("C20").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("D20").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E20").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("C34").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("D34").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E34").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Sheets("Reg 6 Report").Select
    Range("C15").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("D15").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E15").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E16").Select
                
    Application.DisplayAlerts = False
    Sheets("Sheet2").Select
    ActiveSheet.Delete
    Sheets("Sheet3").Select
    ActiveSheet.Delete
    Sheets("Sheet5").Select
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    
End Sub
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Sort by date Sort by votes
Hello

It’s a lengthy code, so I had to make small changes to accommodate my sample data and workbook structure, but the following seems to work:

Code: 
Sub RunAllMacros()
 Pickfile
 FD20Pivot1
 FD20Pivot2
 Pickfile2
 ND2APivot1
 ND2APivot2
End Sub




Sub Pickfile()
Dim filestoopen, x, thiswb
'Sets file types to display in file picker (this example is set for .xls files
    filestoopen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.xlsx), *.xlsx", _
      MultiSelect:=True, Title:="Workbook(s) to open")


'Section to enable file picker
   If TypeName(filestoopen) = "Boolean" Then
        MsgBox "No Files were selected"
        Exit Sub
    End If
    x = 1
    While x <= UBound(filestoopen)
    Application.DisplayAlerts = False
        Workbooks.Open Filename:=filestoopen(x)
        x = x + 1
        
'Records selected workbooks name
thiswb = ActiveWorkbook.Name


'activate a workbook by stored variable name
Workbooks(thiswb).Activate


Wend


End Sub


Sub FD20Pivot1()


'creates FD20 DEF pivot table


Dim pcache As PivotCache, LastRow As Long, pt As pivottable, rng, cell


 Worksheets("DEF Data").Activate
 Set pcache = ActiveWorkbook.PivotCaches.Create(SourceType:=1, SourceData:=Range("A1").CurrentRegion.Address)
     Worksheets.Add
    ActiveSheet.Name = "Sheet 1"
    ActiveWindow.DisplayGridlines = False
 Set pt = ActiveSheet.PivotTables.Add(PivotCache:=pcache, TableDestination:=Range("A1"), TableName:="PivotTable1")
     
 'Select fields for PivotTable
     ActiveWorkbook.ShowPivotTableFieldList = True
    
     With pt.PivotFields("Status")
         .Orientation = xlRowField
         .Position = 1
     End With
     With pt.PivotFields("GROUP")
         .Orientation = xlRowField
         .Position = 2
     End With
     pt.AddDataField pt.PivotFields("STAT"), "Count of STAT", xlCount
     With pt.PivotFields("Count of STAT")
         .Caption = "Count of STAT"
         .Function = xlCount
     End With
     pt.AddDataField pt.PivotFields("Amount"), "Sum of Amount", xlCount
     With pt.PivotFields("Sum of Amount")
         .Caption = "Sum of Amount"
         .Function = xlSum
     End With
     With pt.PivotFields("STATUS")
        .Orientation = xlPageField
    End With
     pt.AddDataField pt.PivotFields("Absolute"), "Sum of Absolute", xlCount
     With pt.PivotFields("Sum of Absolute")
         .Caption = "Sum of Absolute"
         .Function = xlSum
     End With
     ActiveWorkbook.ShowPivotTableFieldList = False
     ActiveSheet.Name = "DEFPivot"
     Rows("1:2").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     
'DEF status 1 calculation to report
    ActiveSheet.PivotTables("PivotTable1").PivotFields("STATUS").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("STATUS").CurrentPage = "1"
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "DEFPivot2"
    Sheets("DEF Report").Select
    Range("A9:E20").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    ActiveSheet.Name = "Sheet2"
    Range("A1").Select
    Application.CutCopyMode = False
    Range("A2").Select
    Sheets("DEF Report").Select
    Range("A23:E34").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    ActiveSheet.Name = "Sheet3"
    Range("A1").Select
    Application.CutCopyMode = False
    Range("A2").Select
    Sheets("Sheet2").Select
    Range("A1").Select
       
    Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 1).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C2:R20000C2,MATCH(RC[-1],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 1).Copy
            cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next


    Columns("C:C").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 2).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C3:R20000C3,MATCH(RC[-2],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 2).Copy
            cell.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("D:D").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
         Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 3).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C4:R20000C4,MATCH(RC[-3],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 3).Copy
            cell.Offset(0, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("E:E").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Range("A1:E12").Select
    Selection.Copy
    Sheets("DEF Report").Select
    Range("A9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
'DEF status 2 calculation to report
    Sheets("DEFPivot").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("STATUS").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("STATUS").CurrentPage = "2"
    Sheets("Sheet3").Select
          
    Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 1).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C2:R20000C2,MATCH(RC[-1],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 1).Copy
            cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next


    Columns("C:C").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 2).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C3:R20000C3,MATCH(RC[-2],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 2).Copy
            cell.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("D:D").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
         Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 3).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C4:R20000C4,MATCH(RC[-3],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 3).Copy
            cell.Offset(0, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("E:E").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Range("A1:E12").Select
    Selection.Copy
    Sheets("DEF Report").Select
    Range("A23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub


Sub FD20Pivot2()
 'Reg 6 pivot
 Dim pcache, pt, rng, cell
    Worksheets("Reg 6 Data").Activate
 Set pcache = ActiveWorkbook.PivotCaches.Create(SourceType:=1, SourceData:=Range("A1").CurrentRegion.Address)
     Worksheets.Add
    ActiveSheet.Name = "Sheet 4"
    ActiveWindow.DisplayGridlines = False
 Set pt = ActiveSheet.PivotTables.Add(PivotCache:=pcache, TableDestination:=Range("A1"), TableName:="PivotTable1")
     
 'Select fields for PivotTable
     ActiveWorkbook.ShowPivotTableFieldList = True
     With pt.PivotFields("GROUP")
         .Orientation = xlRowField
         .Position = 1
     End With
     pt.AddDataField pt.PivotFields("Status Code"), "Count of Status Code", xlCount
     With pt.PivotFields("Count of Status Code")
         .Caption = "Count of Status Code"
         .Function = xlCount
     End With
     pt.AddDataField pt.PivotFields("Amount"), "Sum of Amount", xlCount
     With pt.PivotFields("Sum of Amount")
         .Caption = "Sum of Amount"
         .Function = xlSum
     End With
     pt.AddDataField pt.PivotFields("Absolute"), "Sum of Absolute", xlCount
     With pt.PivotFields("Sum of Absolute")
         .Caption = "Sum of Absolute"
         .Function = xlSum
     End With
     ActiveWorkbook.ShowPivotTableFieldList = False
     ActiveSheet.Name = "REG6Pivot"
     Rows("1:2").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
'REG6 calculation to report
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "REG6Pivot2"
    Sheets("Reg 6 Report").Select
    Range("B4:E4").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("A4:E15").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    ActiveSheet.Name = "Sheet5"
    Sheets("Sheet5").Select
    Range("A1").Select
    Range("B1:E2").Select
    Selection.Cut
    Range("F1").Select
    ActiveSheet.Paste
       
    Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 1).FormulaR1C1 = _
            "=INDEX(REG6Pivot!R1C2:R10000C2,MATCH(RC[-1],REG6Pivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 1).Copy
            cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next


    Columns("C:C").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 2).FormulaR1C1 = _
            "=INDEX(REG6Pivot!R1C3:R20000C3,MATCH(RC[-2],REG6Pivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 2).Copy
            cell.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("D:D").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
         Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 3).FormulaR1C1 = _
            "=INDEX(REG6Pivot!R1C4:R20000C4,MATCH(RC[-3],REG6Pivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 3).Copy
            cell.Offset(0, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("E:E").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Range("F1:I2").Select
    Selection.Cut
    Range("B1").Select
    ActiveSheet.Paste
            
    Range("A1:E12").Select
    Selection.Copy
    Sheets("Reg 6 Report").Select
    Range("A4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("DEF Report").Select
    Range("C20").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("D20").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E20").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("C34").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("D34").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E34").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Sheets("Reg 6 Report").Select
    Range("C15").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("D15").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E15").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E16").Select
                
    Application.DisplayAlerts = False
    Sheets("Sheet2").Select
    ActiveSheet.Delete
    Sheets("Sheet3").Select
    ActiveSheet.Delete
    Sheets("Sheet5").Select
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Sub Pickfile2()
  Dim filestoopen, x, thiswb
   'Sets file types to display in file picker (this example is set for .xls files
    filestoopen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.xlsx), *.xlsx", _
      MultiSelect:=True, Title:="Workbook(s) to open")


'Section to enable file picker
   If TypeName(filestoopen) = "Boolean" Then
        MsgBox "No Files were selected"
        Exit Sub
    End If
    x = 1
    While x <= UBound(filestoopen)
    Application.DisplayAlerts = False
        Workbooks.Open Filename:=filestoopen(x)
        x = x + 1
        
'Records selected workbooks name
thiswb = ActiveWorkbook.Name


'activate a workbook by stored variable name
Workbooks(thiswb).Activate


Wend


End Sub


Sub ND2APivot1()
Dim pcache, pt, rng, cell
'creates ND2A DEF pivot table


 Worksheets("DEF Data").Activate
 Set pcache = ActiveWorkbook.PivotCaches.Create(SourceType:=1, SourceData:=Range("A1").CurrentRegion.Address)
     Worksheets.Add
    ActiveSheet.Name = "Sheet 1"
    ActiveWindow.DisplayGridlines = False
 Set pt = ActiveSheet.PivotTables.Add(PivotCache:=pcache, TableDestination:=Range("A1"), TableName:="PivotTable1")
     
 'Select fields for PivotTable
     ActiveWorkbook.ShowPivotTableFieldList = True
    
     With pt.PivotFields("Status")
         .Orientation = xlRowField
         .Position = 1
     End With
     With pt.PivotFields("GROUP")
         .Orientation = xlRowField
         .Position = 2
     End With
     pt.AddDataField pt.PivotFields("STAT"), "Count of STAT", xlCount
     With pt.PivotFields("Count of STAT")
         .Caption = "Count of STAT"
         .Function = xlCount
     End With
     pt.AddDataField pt.PivotFields("Amount"), "Sum of Amount", xlCount
     With pt.PivotFields("Sum of Amount")
         .Caption = "Sum of Amount"
         .Function = xlSum
     End With
     pt.AddDataField pt.PivotFields("Absolute"), "Sum of Absolute", xlCount
     With pt.PivotFields("Sum of Absolute")
         .Caption = "Sum of Absolute"
         .Function = xlSum
     End With
     ActiveWorkbook.ShowPivotTableFieldList = False
     ActiveSheet.Name = "DEFPivot3"
     Rows("1:2").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
'DEF status 1 calculation to report
    
    Sheets("DEF Report").Select
    Range("A9:E20").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    ActiveSheet.Name = "Sheet2"
    Range("A1").Select
    Application.CutCopyMode = False
    Range("A2").Select
    Sheets("DEF Report").Select
    Range("A23:E34").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    ActiveSheet.Name = "Sheet3"
    Range("A1").Select
    Application.CutCopyMode = False
    Range("A2").Select
    Sheets("Sheet2").Select
    Range("A1").Select
    
    Sheets("DEFPivot").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Status").ClearAllFilters
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Status")
        .PivotItems("2").Visible = False
    End With
    Sheets("Sheet2").Select
       
    Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 1).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C2:R20000C2,MATCH(RC[-1],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 1).Copy
            cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next


    Columns("C:C").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 2).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C3:R20000C3,MATCH(RC[-2],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 2).Copy
            cell.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("D:D").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
         Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 3).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C4:R20000C4,MATCH(RC[-3],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 3).Copy
            cell.Offset(0, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("E:E").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Range("A1:E12").Select
    Selection.Copy
    Sheets("DEF Report").Select
    Range("A9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
'DEF status 2 calculation to report
    Sheets("DEFPivot").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Status").ClearAllFilters
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Status")
        .PivotItems("1").Visible = False
    End With
    Sheets("Sheet3").Select
          
    Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 1).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C2:R20000C2,MATCH(RC[-1],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 1).Copy
            cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next


    Columns("C:C").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 2).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C3:R20000C3,MATCH(RC[-2],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 2).Copy
            cell.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("D:D").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
         Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 3).FormulaR1C1 = _
            "=INDEX(DEFPivot!R1C4:R20000C4,MATCH(RC[-3],DEFPivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 3).Copy
            cell.Offset(0, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("E:E").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Range("A1:E12").Select
    Selection.Copy
    Sheets("DEF Report").Select
    Range("A23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub
        
Sub ND2APivot2()
Dim pcache, pt, rng, cell
'creates ND2A REG6 pivot table


 Worksheets("Reg 6 Data").Activate
 Set pcache = ActiveWorkbook.PivotCaches.Create(SourceType:=1, SourceData:=Range("A1").CurrentRegion.Address)
     Worksheets.Add
    ActiveSheet.Name = "Sheet 4"
    ActiveWindow.DisplayGridlines = False
 Set pt = ActiveSheet.PivotTables.Add(PivotCache:=pcache, TableDestination:=Range("A1"), TableName:="PivotTable1")
     
 'Select fields for PivotTable
     ActiveWorkbook.ShowPivotTableFieldList = True
     With pt.PivotFields("GROUP")
         .Orientation = xlRowField
         .Position = 1
     End With
     pt.AddDataField pt.PivotFields("Status Code"), "Count of Status Code", xlCount
     With pt.PivotFields("Count of Status Code")
         .Caption = "Count of Status Code"
         .Function = xlCount
     End With
     pt.AddDataField pt.PivotFields("Amount"), "Sum of Amount", xlCount
     With pt.PivotFields("Sum of Amount")
         .Caption = "Sum of Amount"
         .Function = xlSum
     End With
     pt.AddDataField pt.PivotFields("Absolute"), "Sum of Absolute", xlCount
     With pt.PivotFields("Sum of Absolute")
         .Caption = "Sum of Absolute"
         .Function = xlSum
     End With
     ActiveWorkbook.ShowPivotTableFieldList = False
     ActiveSheet.Name = "REG6Pivot3"
     Rows("1:2").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
'REG6 calculation to report
    Sheets("Reg 6 Report").Select
    Range("B4:E4").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("A4:E15").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    ActiveSheet.Name = "Sheet5"
    Sheets("Sheet5").Select
    Range("A1").Select
    Range("B1:E2").Select
    Selection.Cut
    Range("F1").Select
    ActiveSheet.Paste
       
    Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 1).FormulaR1C1 = _
            "=INDEX(REG6Pivot!R1C2:R10000C2,MATCH(RC[-1],REG6Pivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 1).Copy
            cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next


    Columns("C:C").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 2).FormulaR1C1 = _
            "=INDEX(REG6Pivot!R1C3:R20000C3,MATCH(RC[-2],REG6Pivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 2).Copy
            cell.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("D:D").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
         Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 3).FormulaR1C1 = _
            "=INDEX(REG6Pivot!R1C4:R20000C4,MATCH(RC[-3],REG6Pivot!R1C1:R10000C1,0))"
        End If
    Next
    
    Set rng = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, 3).Copy
            cell.Offset(0, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False = "1"
        End If
    Next
    
    Columns("E:E").Select
    Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Range("F1:I2").Select
    Selection.Cut
    Range("B1").Select
    ActiveSheet.Paste
            
    Range("A1:E12").Select
    Selection.Copy
    Sheets("Reg 6 Report").Select
    Range("A4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("DEF Report").Select
    Range("C20").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("D20").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E20").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("C34").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("D34").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E34").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Sheets("Reg 6 Report").Select
    Range("C15").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("D15").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E15").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
    Range("E16").Select
    Application.DisplayAlerts = False
    Sheets("Sheet2").Select
    ActiveSheet.Delete
    Sheets("Sheet3").Select
    ActiveSheet.Delete
    Sheets("Sheet5").Activate
    ActiveSheet.Delete
    Application.DisplayAlerts = True
End Sub
 
Upvote 0
Worf, thanks for taking the time to help me with my issue. Yeah, it's definitely long, and probably longer than in needs to be. I need to get better at shortening things up while achieving the same desired results. I tried using your revision and receive the same error (run time 1004) on the same line (at the first time it appears in the code)
Code: 
 Set pt = ActiveSheet.PivotTables.Add(PivotCache:=pcache, TableDestination:=Range("A1"), TableName:="PivotTable1")

I tried using new sets of test sheets to see if that would make a difference since I was using my other test sheets repeatedly but it did not help either. Do you have any suggestions or is there additional information I can provide to help troubleshoot this further? thanks again.
 
Upvote 0
Hi

Are you using three workbooks? One for the code and the other two opened with the dialog boxes?
Try fully qualifying the objects as shown below:

Code: 
Sub FD20Pivot1()
'creates FD20 DEF pivot table

Dim pcache As PivotCache, LastRow&, pt As pivottable, rng, cell, dd As Worksheet, ash As Worksheet
Set dd = Worksheets("DEF Data")
dd.Activate
Set pcache = ActiveWorkbook.PivotCaches.Create(SourceType:=1, SourceData:=[COLOR=#ff8c00]dd[/COLOR].Range("A1").CurrentRegion.Address)
Worksheets.Add
ActiveSheet.Name = "Sheet 1"
ActiveWindow.DisplayGridlines = False
Set ash = ActiveSheet
Set pt = ash.PivotTables.Add(PivotCache:=pcache, TableDestination:=[COLOR=#ff8c00]ash[/COLOR].Range("A1"), TableName:="PivotTable1")
 
Upvote 0
Hi Worf - Yes, I'm using 3 workbooks as you mentioned above. After fully qualifying the objects I am receiving the same error at the same line. I tried going back to what I had originally - 2 workbooks (1 for code and 1 opened with dialog box) to run Pickfile, FD20Pivot1 and FD20Pivot2 and it didn't work with the original code or your revisions. Recreated macro in new workbook with new data sheets and still receiving the error there too. Not sure, but it seems like I've given myself a permanent r-t 1004! If we can't figure this out, maybe I will have to try this a different way by having pivot tables already present and using code to refresh the table instead of creating one. Would you have any other ideas? Thanks again Worf
 
Upvote 0
It’s not the time to give up on this method yet...
Are you working with confidential data?
Can you zip the 3 workbooks together and paste a link to the package?
 
Upvote 0
I got your files. The code expects to find table headers at the first row, but they are at the second row at DEF Data.
Try it like this:

Code: 
Dim pcache As PivotCache, LastRow&, pt As PivotTable, rng, cell, dd As Worksheet, ash As Worksheet, lr%
Set dd = Worksheets("DEF Data")
dd.Activate
lr = dd.Range("a" & Rows.Count).End(xlUp).Row
Set pcache = ActiveWorkbook.PivotCaches.Create(SourceType:=1, SourceData:=dd.Range("A2:X" & lr).Address)
Worksheets.Add
ActiveSheet.Name = "Sheet 1"
ActiveWindow.DisplayGridlines = False
Set ash = ActiveSheet
Set pt = ash.PivotTables.Add(PivotCache:=pcache, TableDestination:=ash.Range("A1"), TableName:="PivotTable1")
 
Upvote 0
Worf - you're a saint. Everything is working great. Thanks again for troubleshooting and helping me here.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Combine two codes in one worksheet change events
Replies
3
Views
303
Alex Blakenburg
A
Agnarr
  • Solved
Checkbox Timestamp with VBA
Replies
3
Views
313
bobsan42
bobsan42
The Ruff Report
  • Question
Help adjusting Macro to email multiple cc addresses
Replies
1
Views
444
The Ruff Report
The Ruff Report
The Ruff Report
  • Question
Add multiple attachments from email list
Replies
1
Views
333
Trebor76
T
G
  • Question
Macro Code Help for multiple worksheets.
Replies
1
Views
223
Georgiboy
Georgiboy

Forum statistics

Threads
1,216,110
Messages
6,128,896
Members
449,477
Latest member
panjongshing

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