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



21575

[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