Add One to Highest Alphabet in a String

[truongn2]

Hi,

I have a UserForm with two text boxes. One is where the user will input their full name and the other one is their initials. When the user click submit, it will write those two fields onto a running list on SHEET2. However, it is possible for people to have the same initials. So to avoid duplicate intials, can there be a macro insert an extra letter at the end of the initial to make it unique? Here is an example:


A B
1 DLJA Darren Lee Johnson
2 DLJB Danielle Lynn Jackson
3


So when a third user with the name of "Derrick Lawson Jacobson" enter their information. A macro would go through the list on SHEET2 and realize that they are already two entries with "DLJ", so it will give "Derrick" the initials of "DLJC".

Thanks in advance for your help,
Ngoc

 

[Scott Huish]

What do you want to do when this situation exceeds 26 duplicates?
Can you post the code where it writes it to the sheet?

 

[truongn2]

Yes, I understand the 26 letter limit, I would rather use number myself, but I am working a project that is already defined as using letters so I have to work with that. I do not think we will have enough users to exceed the limit.

Here is the code for writing it to SHEET2:

    ' Select the Section worksheet
    ActiveWorkbook.Sheets("SHEET2").Activate
    Range("A1").Select
    
    
    ' Check for the first empty cell within the A column
    Do
    If IsEmpty(ActiveCell) = False Then
        ActiveCell.Offset(1, 0).Select
    End If


    ' When empty cell is found, add the User's entry
    Loop Until IsEmpty(ActiveCell) = True
    ActiveCell.Value = cbxInitials.Value & "B"
    ActiveCell.Offset(0, 1) = txtFullName.Value

The "B" part in the code is where I would add the incremental letter to the duplicates. I am using "B" for now as an example.

Please let me know if you need any more information.

Thanks,
truongn2

 

[Scott Huish]

First, it's not necessary to select cells in order to work with them. You can work with ranges directly in VBA. You also don't need a loop to find the first empty cell.

Instead of all that, perhaps something like this:

Dim x As Long, i As String
Worksheets("Sheet1").Select
i = cbxinitials.Text
x = Application.WorksheetFunction.CountIf(Range("A:A"), i & "*")
With Range("A" & Rows.Count).End(xlUp)
    .Offset(1) = i & Chr(65 + x)
    .Offset(1, 1) = txtFullName.Text
End With

 

[truongn2]

Thank you very much for your help!