Merge and Label cells if same value

How do I merge cells of same value then label each row of the merged cell by a serial number?
Assuming I have this:This is what I haveand I am trying to achieve this:This is what I want to achieve
I found a way to merge the cells if they are of the same value
For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
    If Cells(i, 1) <> "" Then
        If Cells(i, 1) = Cells(i - 1, 1) Then
            Range(Cells(i, 1), Cells(i - 1, 1)).Merge
        End If
    End If

Open in new window

Any suggestions on how I can proceed with the labelling? Maybe a "do while", but I'm not sure how to make sure it restarts from 1 if the adjacent cell is not merged.
Pearlyn TanAsked:
Who is Participating?
Rgonzo1971Connect With a Mentor Commented:

pls try
RowIdx = 4
Cnt = 1
For idx = 4 To Range("A" & Rows.Count).End(xlUp).Row
    If Cells(idx, 1) = Cells(RowIdx, 1) Then
        Application.DisplayAlerts = False
        Range(Cells(idx, 1), Cells(RowIdx, 1)).Merge
        Application.DisplayAlerts = True
        RowIdx = idx
        Cnt = 1
    End If
    Cells(idx, 2) = Cnt
    Cnt = Cnt + 1

Open in new window

Pearlyn TanAuthor Commented:
Works perfect. Thank you very much!
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.