Merge cells in the same column if they have the same value

[sm3117]

Hi, good morning to all,

I need to merge adjacent cells that are on the same column whenever they have the same value.

I have tried the following code (as part of a longer code), but this function is not working, it does not break, but it does not make any changes neither.

Range("CMIII[[#Headers],[Indicador]]").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.RowHeight = 25
    
        Dim cnt As Integer
        Dim rng As Range
        Dim str As String
        
        For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
        cnt = Cells(i, 1).MergeArea.Count
        Set rng = Range(Cells(i, 2), Cells(i - cnt + 1, 2))
        
        For Each cl In rng
            If Not IsEmpty(cl) Then str = str + vbNewLine + cl
        Next
        If str <> "" Then str = Right(str, Len(str) - 2)
        
        Application.DisplayAlerts = False
        rng.Merge
        rng = str
        Application.DisplayAlerts = True
        
        str = ""
        i = i - cnt + 1
        Next i

I would really appreciate help,

Thanks,
Have a good day!!

 

[James006]

Why you should avoid merged cells ...

Excel-User.com: Avoid Merged cells in Excel