VBA Split Challenge (Excel 2003)

Topic

New Reply

Good morning to all you fine Excel gurus.

Here’s my problem today. I have a column of names that are separated by both a pound sign (#) and a semicolon. My task is to convert the names into initials and populate the same cell with the initials rather than the full names, as the column of names is part of a much larger dataset. I have attached a sample file. I got as far as trying this code before I decided to throw in the towel and ask the pros:

For Each RngCell In OwnRng
txt = RngCell.Value
z = Split(txt, “#”)
If UBound(z) > 0 Then
For i = 0 To UBound(z)
RngCell.Value = z(i) & “,”
Next i
End If
Next RngCell

Naturally, it doesn’t work. It doesn’t do anything about using the initials instead of the full names, and it only grabs the last name in a string. The more I thought about it the more I realized I am not sure how to proceed.

I already have a workaround, where I copy the column of names into a blank column, parse them, replace the full names with the initials, then concatenate and copy back to the original column.

But I thought there might be a more elegant programmatic solution, thus I am again seeking advice and counsel.

As always, I am grateful for any advice or thoughts…

Reply | Quote

Replies

The following assumes that there are no empty cells in the used range of column A, and that you’re not interested in middle initials.

Sub CreateInitials()
Dim r As Long
Dim n As Long
Dim i As Long
Dim strVal As String
Dim arrNames() As String
Dim arrParts() As String
Dim strInitials As String

‘ Last row
n = Range(“A65536”).End(xlUp).Row
‘ Loop through rows
For r = 1 To n
‘ Clear initials
strInitials = “”
‘ Get cell value
strVal = Range(“A” & r)
‘ Get rid of #
strVal = Replace(strVal, “#”, “”)
‘ Split value
arrNames = Split(strVal, “;”)
‘ Loop through names
For i = 0 To UBound(arrNames)
‘ Split name into parts
arrParts = Split(arrNames(i), “,”)
‘ Assemble initials
strInitials = strInitials & “, ” & _
UCase(Left(Trim(arrParts(1)), 1)) & _
UCase(Left(Trim(arrParts(0)), 1))
Next i
‘ Get rid of first “, ”
strInitials = Mid(strInitials, 3)
‘ Replace cell value
Range(“A” & r) = strInitials
Next r
End Sub

Reply | Quote

Hi Hans,

Thank you for your reply.

I just ran your code on the sample file and it looks like it does the trick. I will incorporate it into the larger macro now and let you know.

Thanks so much for your great solution.

Best regards,

Reply | Quote