Select only (merged) cells which contain specified column(s)

Question

So right now I'm developing VBA macro which will be able to select only cells which meet specified conditions. The problem is I have nested list with multiple level cells. Each level is determined by amount of columns merged. So i.e level 0 is ABCDE, level 1 contains cell which merges columns BCDE, level 2 merges only CDE, level 3 DE and level 4 is only E. Please see attached image for better visualization . The problem is i cannot just select columns as it would select all levels at once.

So let's say I want to select only level 1 cells (so cell which is merged from columns BCDE *) - how can I do that in VBA?

Thank you

*) ABCD in original post (c.f. comment)

Answer 1

This procedure lets you chose any given range, and the level you want to select. It determines the row's level by taking the count of columns in the given range as the number of columns required for "Level 0", and subtracts from it the number of columns in the merge range of the last column.

To help illustrate how it works I added an optional variable to write out the level of each row (two columns after the selected range). By default the option is to not show the levels.

T.M.'s Suggestion to check for oSelectRange being nothing to prevent a crash when doing the selection was also added. Thanks :)

Sub Test()
   Call GetRowLevel(Sheet1.Range("A1:E8"), 4, True)
End Sub

Private Sub GetRowLevel(ByVal SearchRange As Range, ByVal Level As Integer, Optional ShowLevel As Boolean = False)

    Dim oLevel0 As Integer      ' Number of columns in Level 0
    oLevel0 = SearchRange.Columns.Count

    Dim oRowCounter As Long
    Dim oSelectRange As Range
    Set oSelectRange = Nothing

    For oRowCounter = 1 To SearchRange.Rows.Count
        If oLevel0 - SearchRange.Cells(oRowCounter, SearchRange.Columns.Count).MergeArea.Columns.Count = Level Then

            If oSelectRange Is Nothing Then
                Set oSelectRange = SearchRange.Cells(oRowCounter, SearchRange.Columns.Count).MergeArea
            Else
                Set oSelectRange = Application.Union(oSelectRange, SearchRange.Cells(oRowCounter, SearchRange.Columns.Count).MergeArea)
            End If
        End If

        'Testing: Show Levels
        If ShowLevel Then
            Sheet1.Cells(oRowCounter, SearchRange.Columns.Count + 2).Value = oLevel0 - SearchRange.Cells(oRowCounter, SearchRange.Columns.Count).MergeArea.Columns.Count
        End If
    Next

    If Not oSelectRange Is Nothing Then oSelectRange.Select
End Sub

Answer 2

Select defined levels

"... So i.e level 0 is ABCDE, level 1 contains cell which merges columns BCDE, level 2 merges only CDE, level 3 DE and level 4 is only E."

This approach selects all items of a given Level (as defined above) using the MergeCells and MergeArea properties to check for merged cells at the defined Level via helper function bIsLevel().

Applied method

Basically it

1. checks each cell c in a defined range *) whether it belongs to a merged cells range (If c.MergeCells Then ...),
2. gets the resulting c.MergeArea.Address,
3. checks found addresses against the wanted level x address via helper function bIsLevel()

Note to recent Edit in 1st loop condition

*) As MergeArea.Addresses only show the first included range (top/left cell in merge range), it is possible to narrow the search range from e.g. .UsedRange to the column therein corresponding to Level + 1; therefore I edited For Each c In Intersect(.UsedRange, .Columns(Level + 1)) as new loop condition instead.

Calling the main procedure SelectLevel

Procedure SelectLevel has two optional parameters: (1) the wanted Level as defined by OP, (2) the qualified worksheet name. It can be called by the following example statement (Note: if you don't assign the 1st argument, level 0 is assumed by default, the 2nd argument defaults to a worksheet name of your choice and should be changed to your a current sheet name).

     SelectLevel 1     ' e.g. level 1 selects all merged cells of columns B:E

Main procedure SelectLevel

Sub SelectLevel(Optional Level& = 0, Optional ByVal SheetName$ = "MySheet")
Dim c As Range, rng As Range, i&
With ThisWorkbook.Worksheets(SheetName)
    For Each c In Intersect(.UsedRange, .Columns(Level + 1))
        If c.MergeCells Then
           If c.Address = Left(c.MergeArea.Address, Len(c.Address)) Then
              If bIsLevel(c, Level) Then
                 If rng Is Nothing Then
                    Set rng = c
                 Else
                    Set rng = Application.Union(rng, c)
                 End If
              End If
           End If
        End If
    Next
End With
' Execute selection of wanted level
If Not rng Is Nothing Then
       rng.Select
Else
       MsgBox "Found no LEVEL" & Level & " items.", vbExclamation, "No Selection"
End If
End Sub

Helper function bIsLevel()

Function bIsLevel(currCell As Range, ByVal lvl&) As Boolean
Dim LevelAddress$, CellAddress$
Dim arr(): arr = Array("A", "B", "C", "D", "E")
LevelAddress = arr(lvl) & ":" & arr(UBound(arr))    ' define Level columns due to OP
CellAddress = Split(currCell.MergeArea.Address, "$")(1) & ":" & _
              Split(currCell.MergeArea.Address, "$")(3)
bIsLevel = (LevelAddress = CellAddress)

'If bIsLevel Then Debug.Print "cell " & currCell.Address & " in currcell.MergeArea " & currCell.MergeArea.Address & _
                         " (" & CellAddress & " equ./LEVEL" & lvl & " " & LevelAddress & ")"

End Function