Macro to append to cell

[Neal Schultz]

Could someone please assist with this via macro?

Column A contains multiple rows of data. The data is the same in consecutive 3 rows:

XYZ45789
XYZ45789
XYZ45789
XYZ45790
XYZ45790
XYZ45790
XYZ45791
XYZ45791
XYZ45791
XYZ45792
XYZ45792
XYZ45792
XYZ45793
XYZ45793
XYZ45793
XYZ45794
XYZ45794
XYZ45794

Macro to loop through the column appending an A to the second instance of same data and a B to the third instance. Continue looping until end of data in column A. To achieve this:

XYZ45789
XYZ45789 A
XYZ45789 B
XYZ45790
XYZ45790 A
XYZ45790 B
XYZ45791
XYZ45791 A
XYZ45791 B
XYZ45792
XYZ45792 A
XYZ45792 B
XYZ45793
XYZ45793 A
XYZ45793 B
XYZ45794
XYZ45794 A
XYZ45794 B

 

[Chihiro]

Something like this?

Sub cOccurrence()
Dim cRange As Range
Dim lRow As Integer
Dim vCount As Integer

lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

With Sheet1
For i = 1 To lRow
    vCount = Application.WorksheetFunction.CountIf(Range("A1:A" & i), Range("A" & i) & "*")
    If vCount > 1 Then
    Select Case vCount
        Case Is = 1
            Range("A" & i) = Range("A" & i)
        Case Is = 2
            Range("A" & i) = Range("A" & i) & "A"
        Case Is = 3
            Range("A" & i) = Range("A" & i) & "B"
    End Select
    Else
    End If
Next
End With
   

End Sub

 

[vletm]

@Neal Schultz
Press [Do it]

 

[shrivallabha]

No Loop idea

Public Sub NoLoop()
With Range("D1:D" & Range("A" & Rows.Count).End(xlUp).Row)
    .Value = ["=A1&""!""&COUNTIF($A$1:A1,A1)"]
    .Value = .Value
    .Replace "!1", ""
    .Replace "!2", "A"
    .Replace "!3", "B"
End With
End Sub

 

[jindon]

Absolutely no loop and one liner.

Sub test()
    [a1:a1000] = [a1:a1000&if(countif(offset(a1:a1000,,,row(1:1000)),a1:a1000)>1,char(63+countif(offset(a1:a1000,,,row(1:1000)),a1:a1000)),"")]
End Sub

 

[Khalid NGO]

Hi to all,

A formula based solution could be:

=A1&SUBSTITUTE(CHAR(MOD(ROW(A1)-1,3)+64),"@","")

Regards,

 

[Neal Schultz]

Thanks to all who replied. Plenty for me to work with from the responses.