How to make duplicated values unique according to a rule

[wrethams]

I have a list of values that are all the same length and end take the
form xxxxxxLO
where x is any letter A-Z.

Several rows contain the same value and I want to make these unique
according to the following rule:

locate next value
check if it's a duplicate
if not move on
else ignore the first instance and replace LO with AB, AC, AD...etc
for all subsequent duplicates

so where I previously had

ABCDEFGLO
ABCDEFGLO
ABCDEFGLO
ABCDEFGLO
ABCDEFGLO
DDGFTGELO
DDGFTGELO
DDGFTGELO

I would now have:

ABCDEFGLO
ABCDEFGAB
ABCDEFGAC
ABCDEFGAD
ABCDEFGAE
DDGFTGELO
DDGFTGEAB
DDGFTGEAC

 

[roger]

I have a list of values that are all the same length and end take the
form xxxxxxLO
where x is any letter A-Z.

Several rows contain the same value and I want to make these unique
according to the following rule:

locate next value
check if it's a duplicate
if not move on
else ignore the first instance and replace LO with AB, AC, AD...etc
for all subsequent duplicates

Does this do what you want?

Public Sub renameUpTo25duplicates()
Dim x As String, y As String
Dim i As Integer, j As Integer

i = 2
j = 66 'B
With Sheet1
x = .Range("A" & (i - 1))
y = .Range("A" & i)
Do Until y = ""
If x = y Then
.Range("A" & i) = Left(y, 6) & "A" & Chr(j)
j = j + 1 'Note: chr(91) = "["
Else
j = 66 'B
x = y
End If
i = i + 1
y = .Range("A" & i)
Loop
End With
End Sub

 

[wrethams]

Thanks Roger for the reply

I can't get it to work - but it is probably because I don't know how
to configure it for my data..

The data is in column A of the sheet - do I need to amend the script
to reflect this?

I have a list of values that are all the same length and end take the
form xxxxxxLO
where x is any letter A-Z.

Several rows contain the same value and I want to make these unique
according to the following rule:

locate next value
check if it's a duplicate
if not move on
else ignore the first instance and replace LO with AB, AC, AD...etc
for all subsequent duplicates

Does this do what you want?

Public Sub renameUpTo25duplicates()
Dim x As String, y As String
Dim i As Integer, j As Integer

i = 2
j = 66 'B
With Sheet1
x = .Range("A" & (i - 1))
y = .Range("A" & i)
Do Until y = ""
If x = y Then
.Range("A" & i) = Left(y, 6) & "A" & Chr(j)
j = j + 1 'Note: chr(91) = "["
Else
j = 66 'B
x = y
End If
i = i + 1
y = .Range("A" & i)
Loop
End With
End Sub