Grouping Rows based on whether text is bold-CodePudding

I am trying to make a macro that will automatically group (collapse) all rows when the text in column A is not in bold. I do not have any code yet, however when I have done it before based on cell color, code taken from here, it has not worked based on the solution provided. Any help will be greatly appreciated.

Rows as they appear

Rows when they are grouped, which I have done manually.

CodePudding user response：

I updated the code you referenced to check the Range.Font.Bold property. This code assumes A as the column with bold values.

Sub RowGrouper()

    Dim rng As Range
    Dim lastRow As Long
    
    lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

    For Each rng In Range(Cells(1, 1), Cells(lastRow, 1)).Cells
        If rng.Font.Bold Then
            rng.Rows.Group
        End If
    Next

End Sub

CodePudding user response：

Just read your additional info on Conditional Formatting.

So, in that case you can simply use the DisplayFormat method and run the same method.

Sub SetGroups()
    
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range, pCell As Range
    
    'Dim dict As Scripting.Dictionary => use if adding the reference 'Microsoft Scripting Runtime'
    'Set dict = New Scripting.Dictionary
    
    Dim dict As Object '=> use when NOT adding the reference 'Microsoft Scripting Runtime'
    Set dict = CreateObject("Scripting.Dictionary")
    Set ws = ActiveSheet
    Set rng = ws.UsedRange
    
    'Set grouping button to top row
    With ws.Outline
        .AutomaticStyles = False
        .SummaryRow = xlAbove
        .SummaryColumn = xlRight
    End With
    
    For Each cell In rng.Cells
        
        If pCell Is Nothing Then
            Set pCell = cell
        End If

        'If cell.Font.Bold And Not dict.Exists(cell.row) Then  
        If cell.DisplayFormat.Font.Bold And Not dict.Exists(cell.row) Then
            dict.Add cell.row, cell.row
            Set pCell = cell
        End If
        
        If dict.Exists(pCell.row) Then
            dict.Item(pCell.row) = cell.row
        End If
    Next
    
    'ungroup all used rows
    rng.Rows.ClearOutline
    For Each Key In dict.Keys
        If (dict(Key) > Key) Then
            Range(Rows(Key   1), Rows(dict(Key))).Rows.Group
        End If
    Next
    
End Sub