VBA code for conditional cell merging

[aniakpit57]

Hello everybody,

I have to type vba code since 1999 and I have forgotten everything.
I need to make an excel vba code that will conditionally merge cells as shown in the image.

Is it possible to help?

Kind regards and respect



1.jpg

[mana]

Option Explicit


Sub test()
    Dim t As Range, rr As Range, r As Range
    Dim i As Long, j As Long, k As Long
    
    Set t = Cells(1).CurrentRegion
    Set rr = t.Resize(, 1)
        
    For i = rr.Count To 2 Step -1
        If rr(i).Value = rr(i - 1).Value Then
            rr(i).Value = Empty
            rr(i - 1).Resize(2).Merge
        End If
    Next
    
    For i = 1 To rr.Count
        If rr(i).Value = rr(i).MergeArea(1).Value Then
            For j = 2 To t.Columns.Count
                Set r = rr(i).MergeArea.Columns(j).Cells
                For k = r.Count To 2 Step -1
                    If r(k).Value = r(k - 1).Value Then
                        r(k).Value = Empty
                        r(k - 1).Resize(2).Merge
                    End If
                Next
            Next
        End If
    Next
             
End Sub