Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.
Sub Increase()
CurrentPage = ActiveSheet.PivotTables("PivotTable2").PivotFields("Parent").CurrentPage
ActiveSheet.PivotTables("PivotTable2").PivotFields("Parent").CurrentPage = CurrentPage + 1
End Sub
Sub Decrease()
CurrentPage = ActiveSheet.PivotTables("PivotTable2").PivotFields("Parent").CurrentPage
ActiveSheet.PivotTables("PivotTable2").PivotFields("Parent").CurrentPage = CurrentPage - 1
End Sub
Sub GroupColumnA()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim top As Range, bottom As Range
Set wkb = ThisWorkbook
Set wks = wkb.Sheets("Sheet1")
On Error Resume Next
'wks.Rows("1:" & wks.Rows.Count).Rows.Ungroup
wks.Rows.Ungroup
For Each rng In wks.Range("A4", wks.Range("A" & wks.Rows.Count).End(xlUp))
If top Is Nothing Then
Set top = rng
Else
If Int(top.Value) <> Int(rng.Value) Then
Set bottom = rng.Offset(-1, 0)
'now group top to bottom
wks.Rows(top.Offset(1, 0).Row & ":" & bottom.Row).Group
Set top = rng
Set bottom = Nothing
End If
End If
Next rng
wks.Outline.ShowLevels RowLevels:=1
End Sub
Sub clearGroups()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Set wkb = ThisWorkbook
Set wks = wkb.Sheets("Sheet1")
On Error Resume Next
'wks.Rows("1:" & wks.Rows.Count).Rows.Ungroup
wks.Outline.ShowLevels rowlevels:=2
wks.Rows.Ungroup
End Sub
DaveSub IterateGroupColumnA()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim showX As Integer
Dim totalVisibleRows As Long, totalRows As Long
'routine assumes groups have been set
Application.ScreenUpdating = False
Set wkb = ThisWorkbook
Set wks = wkb.Sheets("Sheet1")
On Error GoTo errHandler
'determine which is showing children, if any, then hide the rest
For Each rng In wks.Range("A4", wks.Range("A" & wks.Rows.Count).End(xlUp))
If rng.EntireRow.Hidden = False And Int(rng.Value) <> rng.Value Then 'is not parent and is shown (not hidden)
If showX = 0 Then
showX = Int(rng.Value) + 1 'next one to show, if any - otherwise showX is zero
'go ahead and hide it
wks.Rows(rng.Row).ShowDetail = False
ElseIf rng.EntireRow.Hidden = False Then 'hide all the rest
wks.Rows(rng.Row).ShowDetail = False
End If
End If
Next rng
'Second Pass: now find the next to show, and show it
For Each rng In wks.Range("A4", wks.Range("A" & wks.Rows.Count).End(xlUp))
If rng.Value <> Int(rng.Value) Then 'looking at parent
If showX <> 0 Then 'we're showing something
If Int(rng.Value) = showX And rng.EntireRow.Hidden = True Then 'so show it
wks.Rows(rng.Row).ShowDetail = True
End If
ElseIf wks.Rows(rng.Row).Hidden = True Then 'then show the first one
wks.Rows(rng.Row).ShowDetail = True
showX = Int(rng.Value)
End If
End If
Next rng
Application.ScreenUpdating = True
Exit Sub
errHandler:
'if we got here, then show detail didn't work, which means outlining is not on - make that call, now
Call GroupColumnA
End Sub
Sub GroupColumnA()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim top As Range, bottom As Range
Set wkb = ThisWorkbook
Set wks = wkb.Sheets("Sheet1")
ActiveWindow.DisplayOutline = True 'Comment this, and uncomment the next to not see the + signs on the outlining
'ActiveWindow.DisplayOutline = False 'Uncomment this to not see the + signs on the outlining
On Error Resume Next
'wks.Rows("1:" & wks.Rows.Count).Rows.Ungroup
wks.Rows.Ungroup
For Each rng In wks.Range("A4", wks.Range("A" & wks.Rows.Count).End(xlUp))
If top Is Nothing Then
Set top = rng
Else
If Int(top.Value) <> Int(rng.Value) Then
Set bottom = rng.Offset(-1, 0)
'now group top to bottom
wks.Rows(top.Offset(1, 0).Row & ":" & bottom.Row).Group
Set top = rng
Set bottom = Nothing
End If
End If
Next rng
wks.Outline.ShowLevels rowlevels:=1
End Sub
Sub clearGroups()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Set wkb = ThisWorkbook
Set wks = wkb.Sheets("Sheet1")
On Error Resume Next
'wks.Rows("1:" & wks.Rows.Count).Rows.Ungroup
wks.Rows.ClearOutline
End Sub
See attached demo workbook.If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
modify formula same cell multiple times | 15 | 29 | |
VBA name newly created sheet | 4 | 21 | |
Excel VBA - UserForm Label Caption to show recordset data dynamically | 12 | 17 | |
Excel file that does not ask to be saved before exiting | 6 | 19 |
Join the community of 500,000 technology professionals and ask your questions.