SKIP PIVOT TABLE CREATION - NO DATA

blaisjoel

New Member
Joined
Oct 28, 2016
Messages
30
The code is to create a pivot table for each ProdId on the data sheet.
If a value is not found in column "ProdId" I want to be able to skip the pivot table creation.
Code works fine when I don't use the On Error command but a pivot table gets created when ProdId="04" and no match is found.

VBA Code:
Sub FuelReport()

'FUEL REPORT FOR PERSONAL, RED AND WHITE FUEL
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim FilterValue As String
Dim myPivotField As PivotField
Dim RSheet As String
Dim i As Integer
Dim PMonth As String
Dim Wb As Workbook
Dim Filename As String
Dim Path As String
Dim datetoday As String
Dim monthtoday As String
Dim ProdId As String
Dim num As Integer

ActiveSheet.Name = "Table"

For i = 1 To 5
        If i = 1 Then
        RSheet = "PERSONAL"
        FilterValue = "01"
    ElseIf i = 2 Then
        RSheet = "GAS"
        FilterValue = "01"
    ElseIf i = 3 Then
        RSheet = "RED"
        FilterValue = "02"
    ElseIf i = 4 Then
        RSheet = "WHITE"
        FilterValue = "03"
    Else
        RSheet = "DEF"
        FilterValue = "04"
    End If
    
'Define Data Range
Set DSheet = Worksheets("Table")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
    
    'Declare Variables
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = RSheet
    Set PSheet = Worksheets(RSheet)
    
    'Define Pivot Cache
    Set PCache = ActiveWorkbook.PivotCaches.Create _
    (SourceType:=xlDatabase, SourceData:=PRange). _
    CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
    TableName:=RSheet)
    
    
    'Insert Blank Pivot Table
    Set PTable = PCache.CreatePivotTable _
    (TableDestination:=PSheet.Cells(1, 1), TableName:=RSheet)
    
    
    'Insert Row Fields
    With ActiveSheet.PivotTables(RSheet).PivotFields("VehcName")
    .Orientation = xlRowField
    .Position = 1
    End With
    
    With ActiveSheet.PivotTables(RSheet).PivotFields("DrvrName")
    .Orientation = xlRowField
    .Position = 2
    End With
    
    With ActiveSheet.PivotTables(RSheet).PivotFields("Vehicle")
    .Orientation = xlRowField
    .Position = 3
    End With
    
    With ActiveSheet.PivotTables(RSheet).PivotFields("Date")
    .Orientation = xlRowField
    .Position = 4
    End With
    
    
    'Insert Data Field
    With ActiveSheet.PivotTables(RSheet).PivotFields("Quantity")
    .Orientation = xlDataField
    .Position = 1
    .Function = xlSum
    .NumberFormat = "#,##0.00"
    .Name = "Revenue "
    End With
    
    
    'Insert Filter Fields
    With ActiveSheet.PivotTables(RSheet).PivotFields("Prodid")
    .Orientation = xlPageField
    .Position = 1
    End With
    
    Set myPivotField = ActiveSheet.PivotTables(RSheet).PivotFields("Prodid")
    
    myPivotField.CurrentPage = FilterValue
    
    'Show only totals for each DrvrName
    ActiveSheet.PivotTables(RSheet).PivotFields("VehcName").ShowDetail = False
    
    
    'Format Pivot
    TableActiveSheet.PivotTables("SalesPivotTable").ShowTableStyleRowStripes = TrueActiveSheet.PivotTables("SalesPivotTable").TableStyle2 = "PivotStyleMedium9"
    
    
    ActiveWorkbook.TableStyles.Add ("PivotTable Style 1")
    ActiveSheet.PivotTables("White").TableStyle1 = "PivotTable Style 1"
    With ActiveWorkbook.TableStyles("PivotTable Style 1").TableStyleElements( _
        xlTotalRow).Font
        .FontStyle = "Bold"
        .TintAndShade = 0
        .ThemeColor = xlThemeColorDark1
    End With
    With ActiveWorkbook.TableStyles("PivotTable Style 1").TableStyleElements( _
        xlTotalRow).Interior
        .Color = 192
        .TintAndShade = 0
    End With
    ActiveSheet.PivotTables(RSheet).TableStyle2 = "PivotTable Style 1"
    
    'Drill down personal fuel to date
        
    If i = 1 Then
        ActiveSheet.PivotTables("Personal").PivotSelect "VehcName[All]", xlLabelOnly + _
            xlFirstRow, True
        ActiveSheet.PivotTables("Personal").PivotFields("VehcName").DrillTo "Date"
        Call PivotFilter
    End If
        
    'Insert Villeneuve Header for each sheet
    
    Cells(1, 1).Activate

    Rows("1:4").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B1").Value = "Villeneuve Contstruction"
    If i = 5 Then
        Range("B2").Value = RSheet & " FLUID"
    Else
        Range("B2").Value = RSheet & " FUEL"
    End If
    Range("B3").NumberFormat = ("mmmm yyyy")
    datetoday = MonthName(Month(DateAdd("m", -1, Date))) & " " & Year(Date)
    Range("B3").Value = datetoday
    Cells("B3").Select
    Range("B1:C1").Merge
    Range("B1:C1").HorizontalAlignment = xlCenter
    Range("B2:C2").Merge
    Range("B2:C2").HorizontalAlignment = xlCenter
    Range("B3:C3").Merge
    Range("B3:C3").HorizontalAlignment = xlCenter
    Range("B1:C3").BorderAround _
        LineStyle:=xlContinuous, Weight:=xlMedium
    Range("B1:C3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Color = -16777024
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Range("B1:C1").Select
    Selection.Font.Size = 26
    Range("B2:C2").Select
    Selection.Font.Size = 18
    Range("B3:C3").Select
    Selection.Font.Size = 12
    Columns("B:C").Select
    Range("B4:C4").Activate
    Selection.ColumnWidth = 30
    ActiveSheet.PivotTables(RSheet).PivotSelect "VehcName[All]", xlLabelOnly + _
        xlFirstRow, True
        
    On Error GoTo Finish:
    ProdId = Application.Match("04", Range(Cells(2, 9), Cells(21, 9)), 0)
            If Not IsError(ProdId) Then
                i = i
                GoTo Finished
            Else
            End If
    Finish:
        i = 5
    Finished:
    Next i

End Sub
 

Attachments

  • Screenshot 2022-11-30 102811.png
    Screenshot 2022-11-30 102811.png
    18.6 KB · Views: 8

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
With the following code, if an error occurs when trying to apply the filter, a message box is displayed saying so, and then it exits the sub. If no error occurs, it continues with the rest of your code...

VBA Code:
    On Error Resume Next
    myPivotField.CurrentPage = FilterValue
    If Err.Number <> 0 Then
        MsgBox "Filter not applied!", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0

Hope this helps!
 
Upvote 0
Still creates the pivot table so I modified it by giving it the command to delete the current sheet before exit. It works when I apply it using the CTRL+F8 but when I press run it does not work properly. Very Odd.
 
Upvote 0
Actually, I think you'll need to first get a unique list of ProdId's from your source data, and then loop through each item in that unique list to create your pivot tables.

Does this make sense?
 
Upvote 0
Solution
Code:
Sub FuelReport()

'FUEL REPORT FOR PERSONAL, RED AND WHITE FUEL
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim FilterValue As String
Dim myPivotField As PivotField
Dim RSheet As String
Dim i As Integer
Dim PMonth As String
Dim Wb As Workbook
Dim Filename As String
Dim Path As String
Dim datetoday As String
Dim monthtoday As String

ActiveSheet.Name = "Table"

For i = 1 To 5
        If i = 1 Then
        RSheet = "PERSONAL"
        FilterValue = "01"
    ElseIf i = 2 Then
        RSheet = "GAS"
        FilterValue = "01"
    ElseIf i = 3 Then
        RSheet = "RED"
        FilterValue = "02"
    ElseIf i = 4 Then
        RSheet = "WHITE"
        FilterValue = "03"
    Else
        RSheet = "DEF"
        FilterValue = "04"
    End If
 
'Define Data Range
Set DSheet = Worksheets("Table")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)

 
    'Declare Variables
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = RSheet
    Set PSheet = Worksheets(RSheet)
 
    'Define Pivot Cache
    Set PCache = ActiveWorkbook.PivotCaches.Create _
    (SourceType:=xlDatabase, SourceData:=PRange). _
    CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
    TableName:=RSheet)
 
 
    'Insert Blank Pivot Table
    Set PTable = PCache.CreatePivotTable _
    (TableDestination:=PSheet.Cells(1, 1), TableName:=RSheet)
 
 
    'Insert Row Fields
    With ActiveSheet.PivotTables(RSheet).PivotFields("VehcName")
    .Orientation = xlRowField
    .Position = 1
    End With
 
    With ActiveSheet.PivotTables(RSheet).PivotFields("DrvrName")
    .Orientation = xlRowField
    .Position = 2
    End With
 
    With ActiveSheet.PivotTables(RSheet).PivotFields("Vehicle")
    .Orientation = xlRowField
    .Position = 3
    End With
 
    With ActiveSheet.PivotTables(RSheet).PivotFields("Date")
    .Orientation = xlRowField
    .Position = 4
    End With
 
 
    'Insert Data Field
    With ActiveSheet.PivotTables(RSheet).PivotFields("Quantity")
    .Orientation = xlDataField
    .Position = 1
    .Function = xlSum
    .NumberFormat = "#,##0.00"
    .Name = "Revenue "
    End With
 
 
    'Insert Filter Fields
    With ActiveSheet.PivotTables(RSheet).PivotFields("Prodid")
    .Orientation = xlPageField
    .Position = 1
    End With
 
    Set myPivotField = ActiveSheet.PivotTables(RSheet).PivotFields("Prodid")
 
    On Error Resume Next
    myPivotField.CurrentPage = FilterValue
    If Err.Number <> 0 Then
        Worksheets("DEF").Delete
        GoTo finish
    End If
 
    'myPivotField.CurrentPage = FilterValue
 
    'Show only totals for each DrvrName
    ActiveSheet.PivotTables(RSheet).PivotFields("VehcName").ShowDetail = False
 
 
    'Format Pivot
    TableActiveSheet.PivotTables("SalesPivotTable").ShowTableStyleRowStripes = TrueActiveSheet.PivotTables("SalesPivotTable").TableStyle2 = "PivotStyleMedium9"
 
 
    ActiveWorkbook.TableStyles.Add ("PivotTable Style 1")
    ActiveSheet.PivotTables("White").TableStyle1 = "PivotTable Style 1"
    With ActiveWorkbook.TableStyles("PivotTable Style 1").TableStyleElements( _
        xlTotalRow).Font
        .FontStyle = "Bold"
        .TintAndShade = 0
        .ThemeColor = xlThemeColorDark1
    End With
    With ActiveWorkbook.TableStyles("PivotTable Style 1").TableStyleElements( _
        xlTotalRow).Interior
        .Color = 192
        .TintAndShade = 0
    End With
    ActiveSheet.PivotTables(RSheet).TableStyle2 = "PivotTable Style 1"
 
    'Drill down personal fuel to date
      
    If i = 1 Then
        ActiveSheet.PivotTables("Personal").PivotSelect "VehcName[All]", xlLabelOnly + _
            xlFirstRow, True
        ActiveSheet.PivotTables("Personal").PivotFields("VehcName").DrillTo "Date"
        Call PivotFilter
    End If
      
    'Insert Villeneuve Header for each sheet
 
    Cells(1, 1).Activate

    Rows("1:4").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B1").Value = "Villeneuve Contstruction"
    If i = 5 Then
        Range("B2").Value = RSheet & " FLUID"
    Else
        Range("B2").Value = RSheet & " FUEL"
    End If
    Range("B3").NumberFormat = ("mmmm yyyy")
    datetoday = MonthName(Month(DateAdd("m", -1, Date))) & " " & Year(Date)
    Range("B3").Value = datetoday
    Cells("B3").Select
    Range("B1:C1").Merge
    Range("B1:C1").HorizontalAlignment = xlCenter
    Range("B2:C2").Merge
    Range("B2:C2").HorizontalAlignment = xlCenter
    Range("B3:C3").Merge
    Range("B3:C3").HorizontalAlignment = xlCenter
    Range("B1:C3").BorderAround _
        LineStyle:=xlContinuous, Weight:=xlMedium
    Range("B1:C3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Color = -16777024
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Range("B1:C1").Select
    Selection.Font.Size = 26
    Range("B2:C2").Select
    Selection.Font.Size = 18
    Range("B3:C3").Select
    Selection.Font.Size = 12
    Columns("B:C").Select
    Range("B4:C4").Activate
    Selection.ColumnWidth = 30
    ActiveSheet.PivotTables(RSheet).PivotSelect "VehcName[All]", xlLabelOnly + _
        xlFirstRow, True
 
Next i

finish:

Set Wb = ActiveWorkbook
    Path = "Z:\Véro\Fuel Reports\"
    Filename = datetoday
 
    ActiveWorkbook.SaveAs Filename:=Path & Filename & " Fuel Report", FileFormat:=51

Call Email(datetoday)

End Sub
 
Upvote 0
Actually, I think you'll need to first get a unique list of ProdId's from your source data, and then loop through each item in that unique list to create your pivot tables.

Does this make sense?
Worked using the loop but lots of work.
Added a value of 0 to the array since the value "01" is used twice.
Thank you for the suggestion.

Here is the unique List
VBA Code:
Dim uniqueArray() As String
Dim count As Integer
Dim notUnique As Boolean
Dim List As Range
Dim cell As Range

ReDim uniqueArray(0) As String
uniqueArray(0) = 0
count = 0

Dim cl As Range
For Each cl In Range("I2:I21")
    notUnique = False
    For i = LBound(uniqueArray) To UBound(uniqueArray)
        If (cl.Value = uniqueArray(i)) Then
            notUnique = True
            Exit For
        End If
    Next i
    
    If notUnique = False Then
        count = count + 1
        ReDim Preserve uniqueArray(count) As String
        uniqueArray(UBound(uniqueArray)) = cl.Value
    End If
Next cl

    For i = LBound(uniqueArray) To UBound(uniqueArray)
        Range("Y1").Offset(i, 0) = uniqueArray(i)
    Next i

End Sub

Here is the rest of the code

Code:
Dim datetoday As String
Dim monthtoday As String
Dim cell As Range
Dim num As Integer

ActiveSheet.Name = "Table"

Call UniqueList(i)

Range("Y1", Range("Y1").End(xlDown)).Sort Key1:=Range("Y1"), Order1:=xlAscending
Set List = Range(("Y1"), Cells((i - 1), "Y"))

For Each cell In List
    num = cell.Value
    Select Case (num)
    Case (0)
        RSheet = "PERSONAL"
        FilterValue = "01"
    Case (1)
        RSheet = "GAS"
        FilterValue = "01"
    Case (2)
        RSheet = "RED"
        FilterValue = "02"
    Case (3)
        RSheet = "WHITE"
        FilterValue = "03"
    Case (4)
        RSheet = "DEF"
        FilterValue = "04"
    End Select
    
'Define Data Range
Set DSheet = Worksheets("Table")
LastRow = DSheet.Cells(Rows.count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)

    
    'Declare Variables
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = RSheet
    Set PSheet = Worksheets(RSheet)
    
    'Define Pivot Cache
    Set PCache = ActiveWorkbook.PivotCaches.Create _
    (SourceType:=xlDatabase, SourceData:=PRange). _
    CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
    TableName:=RSheet)
    
    
    'Insert Blank Pivot Table
    Set PTable = PCache.CreatePivotTable _
    (TableDestination:=PSheet.Cells(1, 1), TableName:=RSheet)
    
    
    'Insert Row Fields
    With ActiveSheet.PivotTables(RSheet).PivotFields("VehcName")
    .Orientation = xlRowField
    .Position = 1
    End With
    
    With ActiveSheet.PivotTables(RSheet).PivotFields("DrvrName")
    .Orientation = xlRowField
    .Position = 2
    End With
    
    With ActiveSheet.PivotTables(RSheet).PivotFields("Vehicle")
    .Orientation = xlRowField
    .Position = 3
    End With
    
    With ActiveSheet.PivotTables(RSheet).PivotFields("Date")
    .Orientation = xlRowField
    .Position = 4
    End With
    
    
    'Insert Data Field
    With ActiveSheet.PivotTables(RSheet).PivotFields("Quantity")
    .Orientation = xlDataField
    .Position = 1
    .Function = xlSum
    .NumberFormat = "#,##0.00"
    .Name = "Revenue "
    End With
    
    
    'Insert Filter Fields
    With ActiveSheet.PivotTables(RSheet).PivotFields("Prodid")
    .Orientation = xlPageField
    .Position = 1
    End With
    
    Set myPivotField = ActiveSheet.PivotTables(RSheet).PivotFields("Prodid")
        
    myPivotField.CurrentPage = FilterValue
    
    'Show only totals for each DrvrName
    ActiveSheet.PivotTables(RSheet).PivotFields("VehcName").ShowDetail = False
    
    
    'Format Pivot
    TableActiveSheet.PivotTables("SalesPivotTable").ShowTableStyleRowStripes = TrueActiveSheet.PivotTables("SalesPivotTable").TableStyle2 = "PivotStyleMedium9"
    
    
    ActiveWorkbook.TableStyles.Add ("PivotTable Style 1")
    ActiveSheet.PivotTables("White").TableStyle1 = "PivotTable Style 1"
    With ActiveWorkbook.TableStyles("PivotTable Style 1").TableStyleElements( _
        xlTotalRow).Font
        .FontStyle = "Bold"
        .TintAndShade = 0
        .ThemeColor = xlThemeColorDark1
    End With
    With ActiveWorkbook.TableStyles("PivotTable Style 1").TableStyleElements( _
        xlTotalRow).Interior
        .Color = 192
        .TintAndShade = 0
    End With
    ActiveSheet.PivotTables(RSheet).TableStyle2 = "PivotTable Style 1"
    
    'Drill down personal fuel to date
        
    If num = 0 Then
        ActiveSheet.PivotTables("Personal").PivotSelect "VehcName[All]", xlLabelOnly + _
            xlFirstRow, True
        ActiveSheet.PivotTables("Personal").PivotFields("VehcName").DrillTo "Date"
        Call PivotFilter
    End If
        
    'Insert Villeneuve Header for each sheet
    
    Cells(1, 1).Activate

    Rows("1:4").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B1").Value = "Villeneuve Contstruction"
    If num = 4 Then
        Range("B2").Value = RSheet & " FLUID"
    Else
        Range("B2").Value = RSheet & " FUEL"
    End If
    Range("B3").NumberFormat = ("mmmm yyyy")
    datetoday = MonthName(Month(DateAdd("m", -1, Date))) & " " & Year(Date)
    Range("B3").Value = datetoday
    Cells("B3").Select
    Range("B1:C1").Merge
    Range("B1:C1").HorizontalAlignment = xlCenter
    Range("B2:C2").Merge
    Range("B2:C2").HorizontalAlignment = xlCenter
    Range("B3:C3").Merge
    Range("B3:C3").HorizontalAlignment = xlCenter
    Range("B1:C3").BorderAround _
        LineStyle:=xlContinuous, Weight:=xlMedium
    Range("B1:C3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Color = -16777024
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Range("B1:C1").Select
    Selection.Font.Size = 26
    Range("B2:C2").Select
    Selection.Font.Size = 18
    Range("B3:C3").Select
    Selection.Font.Size = 12
    Columns("B:C").Select
    Range("B4:C4").Activate
    Selection.ColumnWidth = 30
    ActiveSheet.PivotTables(RSheet).PivotSelect "VehcName[All]", xlLabelOnly + _
        xlFirstRow, True
Next cell

Set Wb = ActiveWorkbook
    Path = "Z:\Véro\Fuel Reports\"
    Filename = datetoday
    
    ActiveWorkbook.SaveAs Filename:=Path & Filename & " Fuel Report", FileFormat:=51

Call Email(datetoday)

End Sub
 
Upvote 0

Forum statistics

Threads
1,223,950
Messages
6,175,582
Members
452,653
Latest member
craigje92

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