Extracting first letter

[RIZVI]

Hi All,

I am using the following VBA to extract first letters from SKU list. All is fine except when couple of SKUs have matching starting letters, then I get duplicate results. Like say there are items like Chicken Crispy, Chicken Chilly then in both cases i get CC.

Is there a way that ONLY in such conflicing cases ,I get different results say like CCr and CCh instead of CC in both cases.

VBA that I m using is geiven below:

Function GetFirstLetters(rng As Range) As String
'Update 20140325
Dim arr
Dim I As Long
arr = VBA.Split(rng, " ")
If IsArray(arr) Then
For I = LBound(arr) To UBound(arr)
GetFirstLetters = GetFirstLetters & Left(arr(I), 1)
Next I
Else
GetFirstLetters = Left(arr, 1)
End If
End Function

 

[Joe4]

OK, the method I came up with simply add a counter to the end of the value if a duplicate (i.e. 1, 2, 3, ...).

This works in conjunction with your current function. Here is the new VBA procedure:

Sub PopulateItemIDs()

    Dim lr As Long
    Dim rngB As Range
    Dim rngA As Range
    Dim cell As Range
    Dim itemIDBase As String
    Dim itemID As String
    Dim i As Long
    Dim valid As Boolean
    
    Application.ScreenUpdating = False
    
'   Find last row in column B with data
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    
'   Build ranges
    Set rngA = Range("A3:A" & lr)
    Set rngB = Range("B3:B" & lr)
    
'   Loop through all cells
    For Each cell In rngB
'       Make sure cell is not empty
        If cell <> "" Then
'           Calculate Item Id
            itemIDBase = GetFirstLetters(cell)
'           Initialize values
            i = 0
            valid = False
            itemID = itemIDBase
'           Loop through until a unique value is created
            Do Until valid = True
'               See if value is unique on sheet
                If Application.WorksheetFunction.CountIf(rngA, itemID) = 0 Then
                    valid = True
                Else
'                   Add to counter
                    i = i + 1
'                   Add to end of itemID
                    itemID = itemIDBase & i
                End If
            Loop
'           Populate column A
            cell.Offset(0, -1).Value = itemID
        End If
    Next cell
    
    Application.ScreenUpdating = True
    
    MsgBox "Macro complete!"
    
End Sub

And here is the simple example I made up.
The old results with using the function straight on the sheet are shown in column C (results shown in red).
The new results are put in column A by running the VBA procedure above (results shown in blue).

You can see that lines 8, 9, and 11 would have shown duplicates before.

 

[RIZVI]

OK, the method I came up with simply add a counter to the end of the value if a duplicate (i.e. 1, 2, 3, ...).

This works in conjunction with your current function. Here is the new VBA procedure:

Sub PopulateItemIDs()

    Dim lr As Long
    Dim rngB As Range
    Dim rngA As Range
    Dim cell As Range
    Dim itemIDBase As String
    Dim itemID As String
    Dim i As Long
    Dim valid As Boolean
  
    Application.ScreenUpdating = False
  
'   Find last row in column B with data
    lr = Cells(Rows.Count, "B").End(xlUp).Row
  
'   Build ranges
    Set rngA = Range("A3:A" & lr)
    Set rngB = Range("B3:B" & lr)
  
'   Loop through all cells
    For Each cell In rngB
'       Make sure cell is not empty
        If cell <> "" Then
'           Calculate Item Id
            itemIDBase = GetFirstLetters(cell)
'           Initialize values
            i = 0
            valid = False
            itemID = itemIDBase
'           Loop through until a unique value is created
            Do Until valid = True
'               See if value is unique on sheet
                If Application.WorksheetFunction.CountIf(rngA, itemID) = 0 Then
                    valid = True
                Else
'                   Add to counter
                    i = i + 1
'                   Add to end of itemID
                    itemID = itemIDBase & i
                End If
            Loop
'           Populate column A
            cell.Offset(0, -1).Value = itemID
        End If
    Next cell
  
    Application.ScreenUpdating = True
  
    MsgBox "Macro complete!"
  
End Sub

And here is the simple example I made up.
The old results with using the function straight on the sheet are shown in column C (results shown in red).
The new results are put in column A by running the VBA procedure above (results shown in blue).
View attachment 115052

You can see that lines 8, 9, and 11 would have shown duplicates before.

If I am to add 1,2,3 at the end of the items, then my VBA will also resolve the issue of duplicates. This simple idea of adding 1.2.3 at the end of items did not occur to me. and I thank you for that as it solves my issue and in a much simpler way.

RGDS,

Rizvi.M.H.

 

[Joe4]

You are welcome! Glad I was able to help.
Sometimes it helps to have a fresh set of eyes to look at.

I have done stuff like this before, and tried things where you then take the second letter, but what if that then is also a duplicate? And even if you go to the next one, that could still cause a duplicate.
And it could go on-and-on and you have no idea how far you need to program out to. That is when I decided that a counter works much better, and then you do not need to worry about the other stuff!

 

[RIZVI]

I note that even your name has a counter to it

 

[Joe4]

I note that even your name has a counter to it