Looking for duplicates and adding a unique number to each field.

[eagletonm]

Hi

New to this forum and to be honest, pretty new to VB. I've got a huge Excel file which has a lot of duplicates. It's a list of job titles, i.e secretary is listed many times. I want to add a unique number to the end of each duplicate something like secretary_001 secretary_002 and so on. Ideally I would like the number range to restart for each non unique job title/role.

Hope that makes sense. Very confused here.

Thanks

Mark

[doofusboy]

Here's one way to do it and a pic of the Excel file I used to test it.

Sub position_numbering()
'
' position_numbering Macro
'
' counter for each position type
Dim secty_counter As Integer
Dim jan_counter As Integer
Dim vp_counter As Integer
Dim srvp_counter As Integer
Dim pres_counter As Integer
Dim asst_counter As Integer
Dim offr_counter As Integer
' array for each position type
Dim Secty() As String
Dim Jan() As String
Dim VP() As String
Dim SrVP() As String
Dim Pres() As String
Dim Asst() As String
Dim Offr() As String
' variable to hold each position being evaluated
Dim position As String

' set all counters to zero before starting
secty_counter = 0
jan_counter = 0
vp_counter = 0
srvp_counter = 0
pres_counter = 0
asst_counter = 0
offr_counter = 0

For i = 1 To 15
    ' assign cell value to evaluation variable
    position = Range("A" & i).Value
    ' process based on position type
    Select Case position
        Case "secretary"
            ' increase array size by one
            ReDim Secty(secty_counter + 1)
            ' concatenate counter value to position description and assign this
            ' new value to position array
            Secty(secty_counter + 1) = position & "_" & secty_counter + 1
            ' display new position description in column B
            Range("B" & i).Value = position & "_" & secty_counter + 1
            ' increase counter to accomodate next time this position is found
            secty_counter = secty_counter + 1
        Case "janitor"
            ReDim Jan(jan_counter + 1)
            Jan(jan_counter + 1) = position & "_" & jan_counter + 1
            Range("B" & i).Value = position & "_" & jan_counter + 1
            jan_counter = jan_counter + 1
        Case "vice president"
            ReDim VP(vp_counter + 1)
            VP(vp_counter + 1) = position & "_" & vp_counter + 1
            Range("B" & i).Value = position & "_" & vp_counter + 1
            vp_counter = vp_counter + 1
        Case "senior vice president"
            ReDim SrVP(srvp_counter + 1)
            SrVP(srvp_counter + 1) = position & "_" & srvp_counter + 1
            Range("B" & i).Value = position & "_" & srvp_counter + 1
            srvp_counter = srvp_counter + 1
        Case "president"
            ReDim Pres(pres_counter + 1)
            Pres(pres_counter + 1) = position & "_" & pres_counter + 1
            Range("B" & i).Value = position & "_" & pres_counter + 1
            pres_counter = pres_counter + 1
        Case "assistant"
            ReDim Asst(asst_counter + 1)
            Asst(asst_counter + 1) = position & "_" & asst_counter + 1
            Range("B" & i).Value = position & "_" & asst_counter + 1
            asst_counter = asst_counter + 1
        Case "officer"
            ReDim Offr(offr_counter + 1)
            Offr(offr_counter + 1) = position & "_" & offr_counter + 1
            Range("B" & i).Value = position & "_" & offr_counter + 1
            offr_counter = offr_counter + 1
    End Select
        
Next i

'
End Sub