Pivot Table Grouping Question

[mayoung]

In the pivot table below in the column A there are several rows that start with WTY SUBM and a date. Is there away to group those all together in one row based on WTY SUBM?
This pivot table was created using VBA code so if we could take this step further what would be the code to do this? Would be interested in know how to do this if there is away with or without VBA? Any help would be greatly appreciated, Thanks in Advance.

DataminerFile.xml
	A	B	C	D	E	F
25	SHOP NOT HERE	7				7
26	SHOP SERV				1	1
27	SHOP WAIT CUST	13				13
28	SHOP WAIT RNTL	6				6
29	SHOP WAIT SALES	3				3
30	SHOP WAIT SERV				15	15
31	SHOP WAIT STOCK	1				1
32	WTY SUBM	1				1
33	WTY SUBM 02/23		1			1
34	WTY SUBM 03/04	1				1
35	WTY SUBM 03/05	1				1
36	WTY SUBM 03/22	1				1
37	WTY SUBM 03/24			1		1
38	WTY SUBM 03/26	1				1
39	WTY SUBM 04/01	1				1
40	WTY SUBM 04/02	2				2
41	WTY SUBM 04/14	1		1		2
42	WTY SUBM 04/15	3		2		5
43	WTY SUBM 04/22	2				2
44	WTY WAITING SUB	12		4		16
45	Grand Total	100	1	203	35	339
46	Sum of W/O Total	Salesperson
PivotTable

 

[mart37]

Maybe something like this:

Sub Group_WTY()
    Dim rngGroup As Range
    Dim rngRow As Range
    Dim cll As Range
    Dim CaptionRowRange As String
    Dim strSearch As String
    Dim intSearchString As Integer
    
    CaptionRowRange = "Title" 'the caption of the first pivot field in the row section
    strSearch = "WTY SUBM"
    intSearchString = Len(strSearch)
    Set rngRow = ActiveSheet.PivotTables(1).rowrange
    For Each cll In rngRow
        If UCase(Left(cll, intSearchString)) = strSearch Then
            If rngGroup Is Nothing Then
                Set rngGroup = cll
            Else
                Set rngGroup = Union(rngGroup, cll)
            End If
        End If
    Next
    rngGroup.Group
    ActiveSheet.PivotTables(1).PivotFields(CaptionRowRange & "2").ShowDetail = False
    ActiveSheet.PivotTables(1).PivotFields(CaptionRowRange & "2").PivotItems("Group1").Caption = "WTY SUBM"
End Sub

 

[mayoung]

Maybe something like this:

Sub Group_WTY()
    Dim rngGroup As Range
    Dim rngRow As Range
    Dim cll As Range
    Dim CaptionRowRange As String
    Dim strSearch As String
    Dim intSearchString As Integer
   
    CaptionRowRange = "Title" 'the caption of the first pivot field in the row section
    strSearch = "WTY SUBM"
    intSearchString = Len(strSearch)
    Set rngRow = ActiveSheet.PivotTables(1).rowrange
    For Each cll In rngRow
        If UCase(Left(cll, intSearchString)) = strSearch Then
            If rngGroup Is Nothing Then
                Set rngGroup = cll
            Else
                Set rngGroup = Union(rngGroup, cll)
            End If
        End If
    Next
    rngGroup.Group
    ActiveSheet.PivotTables(1).PivotFields(CaptionRowRange & "2").ShowDetail = False
    ActiveSheet.PivotTables(1).PivotFields(CaptionRowRange & "2").PivotItems("Group1").Caption = "WTY SUBM"
End Sub

mart37, Thanks for replying.

Code runs fine until it gets to the last two lines of code then I get a Run-Time Error:

ActiveSheet.PivotTables(1).PivotFields(CaptionRowRange & "2").ShowDetail = False
ActiveSheet.PivotTables(1).PivotFields(CaptionRowRange & "2").PivotItems("Group1").Caption = "WTY SUBM"

Run-Time Error '1004":

Unable to get the PivotFields Property of the PivotTable Class

 

[mart37]

Did you change your fieldname in this line: CaptionRowRange = "Title"

 

[mayoung]

Did you change your fieldname in this line: CaptionRowRange = "Title"

Do you mean to try the code like this?

ActiveSheet.PivotTables(1).PivotFields(CaptionRowRange = ‘Title’).ShowDetail = False
ActiveSheet.PivotTables(1).PivotFields(CaptionRowRange = ‘Title’).PivotItems("Group1").Caption = "WTY SUBM"

 

[mayoung]

Do you mean to try the code like this?

ActiveSheet.PivotTables(1).PivotFields(CaptionRowRange = ‘Title’).ShowDetail = False
ActiveSheet.PivotTables(1).PivotFields(CaptionRowRange = ‘Title’).PivotItems("Group1").Caption = "WTY SUBM"

I figured it out. Thanks

 

[mayoung]

mart37

One more question related to this?

What is had to two groups to " WTY SUBM " but also add "F/I DRD" is it possible to do two at once? If so how would you modify the code?

Thank You in advance...