Debug help - user-defined function in Excel

[TheJTrain]

Hi all -

Non-programmer JTrain went looking for a way to transform a phrase to an acronym in Excel, and thinking strongly of his Google-fu, found this:

Function Acronym(phrase As String) As String
    Dim i As Integer
    Dim ch As String, words As String
    Acronym = ""
    phrase = Trim(phrase)
    If Len(phrase) < 1 Then End
    words = ""
    For i = 1 To Len(phrase)
    ch = UCase(Mid(phrase, i, 1))
    If ch = "-" Or ch = "/" Then ch = " "
    If InStr(" ABCDEFGHIJKLMNOPQRSTUVWXYZ", ch) > 0 Then
        words = words & ch
    End If
    Next i
    If (Len(words) < 1) Then End
    Acronym = Left(words, 1)
    For i = 2 To Len(words)
        ch = Mid(words, i, 1)
        If ch = " " Then
            Acronym = Acronym & Mid(words, i + 1, 1)
        End If
    Next i
End Function

Which seemed to do the trick. And there was much rejoicing.

However, there appears to be an issue where if the phrase starts with a number (e.g. "2015 Has Been Awesome") then it ignores the first word following the number. So instead of the above example becoming "HBA" it comes out "BA" instead.

Any ideas of what to change in the above code to correct that?

Thanks!
JT

 

[KLin]

Function Acronym(phrase As String) As String
    Dim i As Integer
    Dim ch As String, words As String
    Acronym = ""
    phrase = Trim(phrase)
    If Len(phrase) < 1 Then End
    words = ""
    For i = 1 To Len(phrase)
    ch = UCase(Mid(phrase, i, 1))
    If ch = "-" Or ch = "/" Or IsNumeric(ch) Then ch = " "
    If InStr(" ABCDEFGHIJKLMNOPQRSTUVWXYZ", ch) > 0 Then
        words = words & ch
    End If
    Next i
    If (Len(words) < 1) Then End
    Acronym = Left(words, 1)
    For i = 2 To Len(words)
        ch = Mid(words, i, 1)
        If ch = " " Then
            Acronym = Acronym & Mid(words, i + 1, 1)
        End If
    Next i
End Function

changed if ch = "-" Or ch = "/" Then ch = " "

to

f ch = "-" Or ch = "/" Or IsNumeric(ch) Then ch = " "

Check if the character is numeric. If it is, replace the character with a space.

Give that a whirl.

 

[TheJTrain]

Worked like a charm, you rock! Thanks!

JT

 

[Tweak155]

This is probably a lot easier to read and understand, I think it does what you want:

Function Acronym(phrase As String) As String
Dim strAcronym As String, vWord As Variant, ch As String

For Each vWord In Split(phrase, " ")
    If Trim(CStr(vWord)) <> "" Then
        ch = Left(CStr(vWord), 1)
        If ch Like "[A-Z]" Then
            strAcronym = strAcronym & ch
        End If
    End If
Next vWord

Acronym = strAcronym
End Function

Also another tip is if you want it to catch mistype capital letters, for example "2015 has been Awesome" would only catch "A", you can force it to proper case before checking:

phrase = StrConv(phrase, vbProperCase)

It will force something like "2015 has been Awesome" to "2015 Has Been Awesome".

 

[TheJTrain]

That works great too, thanks!