VBA to return the column numbers of the start and finish of a merged cell? RANDOM!

Jim,

One way...

Sub tgr()
    
    Dim rngFound As Range
    Dim arrMerged(1 To 65000, 1 To 3) As Variant
    Dim strFirst As String
    Dim MergedIndex As Long
    Dim i As Long
    
    With Application.FindFormat
        .Clear
        .MergeCells = True
    End With
    
    Set rngFound = Cells.Find(vbNullString, Cells(Rows.Count, Columns.Count), xlValues, xlPart, SearchFormat:=True)
    If Not rngFound Is Nothing Then
        strFirst = rngFound.Address
        Do
            MergedIndex = MergedIndex + 1
            arrMerged(MergedIndex, 1) = rngFound.MergeArea.Address
            arrMerged(MergedIndex, 2) = rngFound.Column
            arrMerged(MergedIndex, 3) = rngFound.Column + rngFound.MergeArea.Columns.Count - 1
            Set rngFound = Cells.Find(vbNullString, rngFound, xlValues, xlPart, SearchFormat:=True)
        Loop While rngFound.Address <> strFirst
        For i = 1 To MergedIndex
            MsgBox "Merged Cell Address:" & vbTab & arrMerged(i, 1) & Chr(10) & _
                   "Start Column Number:" & vbTab & arrMerged(i, 2) & Chr(10) & _
                   "End Column Number:  " & vbTab & arrMerged(i, 3)
        Next i
    End If
    
    Application.FindFormat.Clear
    Set rngFound = Nothing
    Erase arrMerged
    
End Sub

Jim,

another way

Sub TGIF()
Dim cell As Range
For Each cell In ActiveSheet.UsedRange
If cell.MergeCells Then If cell.Address = cell.MergeArea.Cells(1, 1).Address Then MsgBox "Firts cell of merge area: " & cell.MergeArea.Cells(1, 1).Address & " -  Last cell of merge area: " & cell.MergeArea.Cells(cell.MergeArea.Rows.Count, cell.MergeArea.Columns.Count).Address
Next cell

End Sub

Please click the * below if this helps

So you would only want information regarding merged cells that contain the text "model life"?

Sub tgr()
    
    Dim rngFound As Range
    Dim arrMerged(1 To 65000, 1 To 3) As Variant
    Dim strFirst As String
    Dim strFind As String
    Dim MergedIndex As Long
    Dim i As Long
    
    With Application.FindFormat
        .Clear
        .MergeCells = True
    End With
    
    strFind = "model life"
    
    Set rngFound = Cells.Find(strFind, Cells(Rows.Count, Columns.Count), xlValues, xlPart, SearchFormat:=True)
    If Not rngFound Is Nothing Then
        strFirst = rngFound.Address
        Do
            MergedIndex = MergedIndex + 1
            arrMerged(MergedIndex, 1) = rngFound.MergeArea.Address
            arrMerged(MergedIndex, 2) = rngFound.Column
            arrMerged(MergedIndex, 3) = rngFound.Column + rngFound.MergeArea.Columns.Count - 1
            Set rngFound = Cells.Find(strFind, rngFound, xlValues, xlPart, SearchFormat:=True)
        Loop While rngFound.Address <> strFirst
        For i = 1 To MergedIndex
            MsgBox "Merged Cell Address:" & vbTab & arrMerged(i, 1) & Chr(10) & _
                   "Start Column Number:" & vbTab & arrMerged(i, 2) & Chr(10) & _
                   "End Column Number:  " & vbTab & arrMerged(i, 3)
        Next i
    End If
    
    Application.FindFormat.Clear
    Set rngFound = Nothing
    Erase arrMerged
    
End Sub

Btw, the reason I like the .Find method is because it won't waste time looking at cells that are not merged.

You're very welcome