loop through merged cells in a Column to get their addresses

[Sagar0650]

I have one column. say column A, which has multiple merged cells of different ranges.
for example first cell is merged from A2 to A15 whereas second merged cell ranges from A16 to A115
now i want to run through entire column to get the address of each merged cell.
i have code which helps me to get the address of the only first merge cell.
can anyone help me to run a loop to get these cell address?

 

[Sagar0650]

last column is not always fixed, it can vary from range column M to column P

LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

this line i am using to find the last column present.

Column 5 always be E
and yes you got is correct with the msgbox output
like: "output2, output13 and output24"

 

[DanteAmor]

Ok, try this please

Sub get_merged_cells_3()
  Dim c As Range, dic As Object, lc As Long
  Dim r As Range, wMax As Long, wRow As Long, wCad As String
  
  lc = Cells(1, Columns.Count).End(xlToLeft).Column - 1
  Set dic = CreateObject("scripting.dictionary")
  For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
    If c.MergeCells Then
      If Not dic.exists(c.MergeArea.Address(0, 0)) Then
        dic(c.MergeArea.Address(0, 0)) = Empty
        Set r = c.MergeArea
        wMax = WorksheetFunction.Max(r.Offset(, lc).Resize(r.Rows.Count))
        wRow = WorksheetFunction.Match(wMax, r.Offset(, lc).Resize(r.Rows.Count), 0)
        wCad = wCad & WorksheetFunction.Index(r.Offset(, 4).Resize(r.Rows.Count), wRow) & vbLf
      End If
    End If
  Next
  MsgBox wCad, , "Values from column 'E'"
End Sub

 

[Sagar0650]

getting this error
" unable to get the match property of the worksheetfunction class"
also tried with application.worksheetfunction.match
but same error

 

[DanteAmor]

What happens is that you have text in the column where you should only have numbers.
In the example, in column I you should have numbers to find the maximum value.
Please, just for the test, delete the texts or blank spaces.
Also check that indeed the last column is column I. (just to continue with the example)

 

[DanteAmor]

My test data

Book1
	A	B	C	D	E	F	G	H	I	J	K
1	COL1	COL2	COL3	COL4	COL5	COL6	COL7	COL8	COL9
2	Data 1				output1				1
3					output2				2
4					output3				3
5					output4				4
6					output5				5
7					output6				6
8					output7				7
9	Data 2				output8				101
10					output9				17
11					output10				19
12					output11				21
13					output12				23
14					output13				50
15					output14				27
16					output15				29
17					output16				31
18					output17				33
19					output18				35
20					output19				37
21	Data 3				output20				39
22					output21				100
23					output22				43
24					output23				45
25					output24				47
26
Sheet

The code a little compacted:

Sub get_merged_cells_4()
  Dim c As Range, dic As Object, lc As Long
  Dim r As Range, wMax As Long, wRow As Long, wCad As String
 
  lc = Cells(1, Columns.Count).End(xlToLeft).Column - 1
  Set dic = CreateObject("scripting.dictionary")
  For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
    If c.MergeCells And Not dic.exists(c.MergeArea.Address(0, 0)) Then
      dic(c.MergeArea.Address(0, 0)) = Empty
      Set r = c.MergeArea
      wMax = WorksheetFunction.Max(r.Offset(, lc).Resize(r.Rows.Count))
      wRow = WorksheetFunction.Match(wMax, r.Offset(, lc).Resize(r.Rows.Count), 0)
      wCad = wCad & WorksheetFunction.Index(r.Offset(, 4).Resize(r.Rows.Count), wRow) & vbLf
    End If
  Next
  MsgBox wCad, , "Values from column ""E""    "
End Sub

Result:

 

[DanteAmor]

If you have cells with decimals, then change wMax as Long to wMax as Double:

Sub get_merged_cells_4()
  Dim c As Range, dic As Object, lc As Long
  Dim r As Range, wMax As Double, wRow As Long, wCad As String
 
  lc = Cells(1, Columns.Count).End(xlToLeft).Column - 1
  Set dic = CreateObject("scripting.dictionary")
  For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
    If c.MergeCells And Not dic.exists(c.MergeArea.Address(0, 0)) Then
      dic(c.MergeArea.Address(0, 0)) = Empty
      Set r = c.MergeArea
      wMax = WorksheetFunction.Max(r.Offset(, lc).Resize(r.Rows.Count))
      wRow = WorksheetFunction.Match(wMax, r.Offset(, lc).Resize(r.Rows.Count), 0)
      wCad = wCad & WorksheetFunction.Index(r.Offset(, 4).Resize(r.Rows.Count), wRow) & vbLf
    End If
  Next
  MsgBox wCad, , "Values from column ""E""    "
End Sub

Note: That is the importance of putting real examples.

 

[Sagar0650]

Note: That is the importance of putting real examples.

that is the problem where i am not sure if i can share the real example with you.let me see on that.
thank you very much for your efforts.

 

[DanteAmor]

that is the problem where i am not sure if i can share the real example with you.let me see on that.
thank you very much for your efforts.

Did you try my last macro with the sample data?

 

[DanteAmor]

that is the problem where i am not sure if i can share the real example with you.let me see on that.
thank you very much for your efforts.

maybe real data no. but information if the cells have texts, or decimals or empties or spaces or formulas. if the sheet is protected or hidden, if the rows are hidden, if the columns are hidden. That information would help since we can't see what you see.

 

[Sagar0650]

i'll share the exact information with you in coming couple of days.
& this time i'll try to include as much detail as possible so that it would be easy for you to understand the real scenario.
until that time thank you so much for working on the code.
have a nice weekend ahead?