Create a collection of unique Strings

[gmaxey]

The following demonstrates some code I have cobbled together which is intended to ensure that there are no duplicate titles is a collection of titles. Since the application permits duplicate titles I can't remove them but need to ensure that any existing duplicates are renamed. In the example the code renames the duplicates "Bs", "Cs" and "E" with a numbered prefix. It works but I would also like to mofidfy the first "B", "C" and "E" as B<Initial>1, C<Initial>1 etc.

The collection in actual practice won't be know until run time. A solution may be obvious but I don't see it.

Always open to suggestions on a better way. Thanks.



Option Explicit
Sub iTest()
Dim colTitles As Collection 'Collection of unique content control titles
Dim arrInput() As String
'Dim arrOutput() As String
Dim i As Long
Dim pName As String
Set colTitles = New Collection
arrInput = Split("A|B|B|B|C|C|C|D|E|E", "|")
For i = 0 To UBound(arrInput)
pName = arrInput(i)
On Error GoTo Err_UniqueName
Err_UniqueNameReEntry:
colTitles.Add pName, pName
Next
For i = 1 To colTitles.Count
MsgBox colTitles(i)
Next i
Exit Sub
Err_UniqueName:
pName = MakeTitleUnique(pName)
Resume Err_UniqueNameReEntry
End Sub
Function MakeTitleUnique(ByRef pStr As String) As String
Dim pStrFront As String, pStrBack As String
Dim i As Long
If InStr(pStr, "<Duplicate#>") = 0 Then
MakeTitleUnique = pStr & "<Duplicate#>2"
Exit Function
End If
pStrBack = Right(pStr, Len(pStr) - InStrRev(pStr, "<Duplicate#>") - 11)
pStrFront = Left(pStr, Len(pStr) - Len(pStrBack))
i = CLng(pStrBack)
i = i + 1
pStrBack = CStr(i)
MakeTitleUnique = pStrFront & pStrBack
End Function