VBA Expand PivotTable if count is bigger than 10

[th259]

Uploaded is an image of a pivottable with a filter for 10 or more on the count field. How do I expand each of them to a new spreadsheet and name the new spreadsheet with just the first word on the Vendor Name column, and create new pivot table on the new worksheets like the one on the second image?

 

[th259]

Upping this thread! I found the following code but I get a run-time error '1004'. One of the name was more than 31 characters. How do I change it so the worksheet name is only the first 20 characters or smaller if the name is shorter than that, and how do I change it so that the showdetails is only for visible rows or for row with count of 10 or more?

Dim lCol As Long
    Dim c As Range
    Dim sRow As String
    sRow = "Row Labels"
    With ActiveSheet.PivotTables("multiple_lines")
        With .RowRange
            On Error Resume Next
            lCol = WorksheetFunction.Match(sRow, .Resize(1), 0)
            On Error GoTo 0
            If lCol = 0 Then
                MsgBox "Rowfield Header: " & sRow & "not found."
                Exit Sub
            End If
            lCol = .Column + lCol - 1
        End With
        For Each c In .DataBodyRange.Resize(, 1)
           c.ShowDetail = True
           ActiveSheet.Name = .Parent.Cells(c.Row, lCol)
        Next c
    End With

 

[th259]

I found a code that works but how do I get rid of the separate worksheet for the Grand Total?

Dim lCol As Long
    Dim c As Range
    Dim sRow As String
    sRow = "Vendor Name"
    With ActiveSheet.PivotTables("multiple_lines")
        With .RowRange
            On Error Resume Next
            lCol = WorksheetFunction.Match(sRow, .Resize(1), 1)
            On Error GoTo 0
            If lCol = 0 Then
                MsgBox "Rowfield Header: " & sRow & "not found."
                Exit Sub
            End If
            lCol = .Column + lCol - 1
        End With
        For Each c In ActiveSheet.PivotTables("multiple_lines").DataBodyRange.Resize(, 1).SpecialCells(xlCellTypeVisible)
           c.ShowDetail = True
           ActiveSheet.Name = .Parent.Cells(c.Row, lCol)
        Next c
    End With

 

[Alex Blakenburg]

Can it be as simple as adding the lines in blue ?

        For Each c In ActiveSheet.PivotTables("multiple_lines").DataBodyRange.Resize(, 1).SpecialCells(xlCellTypeVisible)
           If c.Value <> "Grand Total" Then
                c.ShowDetail = True
                ActiveSheet.Name = .Parent.Cells(c.Row, lCol)
           End If
        Next c

 

[th259]

It didn't work, the macro is still running but the If code is not doing anything, I'm still getting a new worksheet for the Grand Total.

 

[Alex Blakenburg]

Try this:

        For Each c In ActiveSheet.PivotTables("multiple_lines").DataBodyRange.Resize(, 1).SpecialCells(xlCellTypeVisible)
           If c.Parent.Cells(c.Row, lCol) <> "Grand Total" Then
                c.ShowDetail = True
                ActiveSheet.Name = .Parent.Cells(c.Row, lCol)
           End If
        Next c

 

[th259]

It worked thank you very much!

To make it more complicated, how do I limit the vendor name to the first 20 characters.

 

[Alex Blakenburg]

If you are just referring to the Vendor Name in creating the Sheet Names try this:

                ActiveSheet.Name = Trim(Left(.Parent.Cells(c.Row, lCol), 20))

 

[th259]

I thought it would have been harder. It works, thank you very much!

 

[Alex Blakenburg]

You're welcome.