Having trouble with pivot table macro

[SCPbrito]

I just recorded this macro and when I try to run it I'm getting an error. I'm having a hard time troubleshooting this.

Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Item_Transaction!R1C1:R4709C30", Version:=8).CreatePivotTable _
        TableDestination:="Pivot Table!R1C1", TableName:="PivotTable1", _
        DefaultVersion:=8
    Sheets("Pivot Table").Select
    Cells(1, 1).Select
    With ActiveSheet.PivotTables("PivotTable1")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Time")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Time").AutoGroup
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Quantity"), "Sum of Quantity", xlSum
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("User ID")
        .Orientation = xlRowField
        .Position = 1
    End With
End Sub

 

[RoryA]

If you run it again, it will try and create another pivot table in exactly the same place as the first one. Did you remove the first pivot table before you ran it again?

 

[SCPbrito]

Yes i deleted the Pivot table prior to running it

 

[RoryA]

Just the pivot table, not the Pivot Table worksheet?

What is the error message and which line is highlighted if you click Debug?

 

[SCPbrito]

Yes, just deleted the Pivot Table.

Error pops up as "Invalid procedure call or argument" below is what is highlighted in the debugger

 ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Item_Transaction!R1C1:R4709C30", Version:=8).CreatePivotTable _
        TableDestination:="Pivot Table!R1C1", TableName:="PivotTable1", _
        DefaultVersion:=8

 

[RoryA]

There should be single quotes in the destination address due to the space in the sheet name:

TableDestination:="'Pivot Table'!R1C1"

 

[SCPbrito]

Thank you that fixed it

 

[RoryA]

Also, I'd probably make it a bit more generic:

   Application.CutCopyMode = False
   Dim DataSheet As Worksheet
   Set DataSheet = Sheets("Item_Transaction")
   Dim pc As PivotCache
   Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
            SourceData:="'" & DataSheet.Name & "'!" & DataSheet.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1), _
            Version:=8)
   Dim pt As PivotTable
   Set pt = pc.CreatePivotTable(TableDestination:=Sheets("Pivot Table").Cells(1, "A"))
   With pt
      .ColumnGrand = True
      .HasAutoFormat = True
      .DisplayErrorString = False
      .DisplayNullString = True
      .EnableDrilldown = True
      .ErrorString = ""
      .MergeLabels = False
      .NullString = ""
      .PageFieldOrder = 2
      .PageFieldWrapCount = 0
      .PreserveFormatting = True
      .RowGrand = True
      .SaveData = True
      .PrintTitles = False
      .RepeatItemsOnEachPrintedPage = True
      .TotalsAnnotation = False
      .CompactRowIndent = 1
      .InGridDropZones = False
      .DisplayFieldCaptions = True
      .DisplayMemberPropertyTooltips = False
      .DisplayContextTooltips = True
      .ShowDrillIndicators = True
      .PrintDrillIndicators = False
      .AllowMultipleFilters = False
      .SortUsingCustomLists = True
      .FieldListSortAscending = False
      .ShowValuesRow = False
      .CalculatedMembersInFilters = False
      .RowAxisLayout xlCompactRow
      .RepeatAllLabels xlRepeatLabels
      With pc
         .RefreshOnFileOpen = False
         .MissingItemsLimit = xlMissingItemsDefault
      End With
      With .PivotFields("Time")
         .Orientation = xlColumnField
         .Position = 1
      End With
      .PivotFields("Time").AutoGroup
      .AddDataField .PivotFields("Quantity"), "Sum of Quantity", xlSum
      With .PivotFields("User ID")
         .Orientation = xlRowField
         .Position = 1
      End With
   End With
End Sub

 

[SCPbrito]

I have another macro I'm trying to incorporate into this one. I need to delete rows where the time is before 6:50AM. The column E currently has the date on this new file. How can I modify this code to get me what I need? The sheet name Scan Record would be renamed to Item_Transaction from previous macro.

ActiveWorkbook.Worksheets("Scan_Record").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Scan_Record").Sort.SortFields.Add2 Key:= _
        Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Scan_Record").Sort
    .SetRange Range("$A$1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("B:B").NumberFormat = "[$-en-US]m/d/yy h:mm AM/PM;@"
    
    
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim currentTime As Date
    Dim cutoffTime As Date
  
    ' Set the worksheet
    Set ws = ActiveWorkbook.Sheets("Scan_Record") ' Change "Sheet1" to your sheet name
  
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add2 Key:= _
        Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    'With ws.Sort
    With ws.Sort
        .SetRange ws.Range("$A$1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ws.Columns("B:B").NumberFormat = "[$-en-US]m/d/yy h:mm AM/PM;@"   ' XXX Not sure you need this
    ' Find the last row with data in column B
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    ' Get the current date and time
    currentTime = Now
    ' Set the cutoff time for the current day at 6:50 AM
    cutoffTime = DateValue(currentTime) + TimeValue("06:50:00")

    ' Loop from the last row to the first row (bottom-up)
    Application.ScreenUpdating = False
    For i = lastRow To 1 Step -1
        ' Check if the timestamp in column A is before the cutoff time
        If IsDate(ws.Cells(i, 2).Value) Then
            If ws.Cells(i, 2).Value < cutoffTime Then
                ' Delete the row if the condition is met
                ws.Rows(i).Delete
            End If
        End If
    Next i
    Application.ScreenUpdating = True
  
    MsgBox "Macro complete!"

End Sub

 

[RoryA]

I'm not sure I follow, as it sounds like you just need to change this:

Set ws = ActiveWorkbook.Sheets("Scan_Record")

to this:

Set ws = ActiveWorkbook.Sheets("Item_Transaction")