Find Merged Cells VBA

[Admin]

Hi All,

Here is a function to find merged cells. Hope this would find useful

Function FindMergedCells(ByRef RangeToSearch As Range) As Range
        
    'Krishnakumar @ ExcelFox.com
    Dim dic     As Object
    Dim r       As Long
    Dim c       As Long
    Dim k, i    As Long
    Dim UB1     As Long
    Dim UB2     As Long
    
    UB1 = RangeToSearch.Rows.Count
    UB2 = RangeToSearch.Columns.Count
    
    Set dic = CreateObject("scripting.dictionary")
    
    For r = 1 To UB1
        For c = 1 To UB2
            If RangeToSearch.Cells(r, c).MergeArea.Cells.Count > 1 Then
                dic.Item(RangeToSearch.Cells(r, c).MergeArea.Cells.Address(0, 0)) = Empty
            End If
        Next
    Next
    
    If dic.Count Then
        k = dic.keys
        For i = LBound(k) To UBound(k)
            If FindMergedCells Is Nothing Then
                Set FindMergedCells = RangeToSearch.Range(CStr(k(i)))
            Else
                Set FindMergedCells = Union(FindMergedCells, RangeToSearch.Range(CStr(k(i))))
            End If
        Next
    End If
    
End Function

and call the function like..

Sub kTest()
    
    Dim c As Range
    
    Set c = FindMergedCells(Range("j1:n1000"))
    If Not c Is Nothing Then c.Interior.Color = 65535

End Sub

Enjoy !!

[Rick Rothstein]

Here is a shorter, quicker (it only iterates as many times as there are merged cells) function that will return the same value as your function does, and so you would call it the same way you indicated for calling your function...

Function FindMergedCells(RangeToSearch As Variant) As Range
  Dim MergedCell As Range, FirstAddress As String
  If TypeName(RangeToSearch) = "String" Then Set RangeToSearch = Range(RangeToSearch)
  Application.FindFormat.MergeCells = True
  Set MergedCell = RangeToSearch.Find("", LookAt:=xlPart, SearchFormat:=True)
  If Not MergedCell Is Nothing Then
    FirstAddress = MergedCell.Address
    Do
      If FindMergedCells Is Nothing Then
        Set FindMergedCells = MergedCell
      Else
        Set FindMergedCells = Union(FindMergedCells, MergedCell)
      End If
      Set MergedCell = RangeToSearch.Find("", After:=MergedCell, LookAt:=xlPart, SearchFormat:=True)
      If MergedCell Is Nothing Then Exit Do
    Loop While FirstAddress <> MergedCell.Address And Not MergedCell Is Nothing
  End If
End Function

Note that my function allows the programmer to pass the argument in as either an actual range object OR the string address for a range. So, using the Set statement from example calling statement, my function could be called either this way...

Set c = FindMergedCells(Range("J1:N1000"))

or this way...

Set c = FindMergedCells("J1:N1000")

[Admin]

Hi Rick,

I thought about the findformat method. But I think findformat was introduced in XL 2002/2003 (not sure which one).

So I thought it would be better a function whch works on all versions(not sure about XL 97 though)

Another point, if you pass a string it must be a range address, otherwise it would throw error.

I did a small test on A1:K10000 with 1169 merged areas, and the average time taken is as follows:

Ricks - 5 secs
Mine - 7 secs

Anyway thanks for posting an alternative (I would say native) method.

[Rick Rothstein]

I thought about the findformat method. But I think findformat was introduced in XL 2002/2003 (not sure which one).

So I thought it would be better a function whch works on all versions(not sure about XL 97 though)

I only have XL2003 and XL2007 installed, plus I only came to Excel maybe 5 years ago, so I am unaware of any limitation on versions of Excel prior to XL2003. Besides, why worry about earlier versions of Excle... everyone has moved up to at least XL2003 by now, right?

Another point, if you pass a string it must be a range address, otherwise it would throw error.

Isn't that what functions normally do when they get passed invalid arguments? I would think it is up to the programmer to either filter out improper argument values before the function is called or to handle errors generated by the function after they are produced. Did you have something different in mind for what my function should do if the passed in String value was not a range address?

I did a small test on A1:K10000 with 1169 merged areas, and the average time taken is as follows:

Ricks - 5 secs
Mine - 7 secs

While I would always expect my function to be faster than what you posted, the percentage difference between them is highly dependent on the number of merged cells involved. Both of our routines repeatedly use the Union function for each merged cell in the range. You test with 1169 merged cells means 1169 Union operations... the Union method gets progressively slower with each new member added to it and I think 1169 of them is enough to slow things down noticeably and, as a result, hide the true difference between our codes. What times do you get if you repeat that test with, say, 5 merged areas?

[Admin]

I know people who still use XL 2000

I have no doubt that your function is faster as it only loops only on merged areas where as mine loops on every cells. But as I said, I wrote this function keeping in mind the version compitability.