VBA: Calculate Acronyms from Strings
The following function evaluates Acronyms from strings i.e it concatenates the first letter in every word in a string. E.g “trees are green” becomes “TAG”.
The routine traverses every character in a string and if it is a space then it takes the next character in the string. Before evaluating the string, it removes all trailing and duplicate spaces.
Function Acroymn (Original_String As String) As String Dim Trimmed_String As String Dim Length As Integer Dim Pos As Integer Trimmed_String = Application.WorksheetFunction.Trim(Original_String) 'work out the length of the string Length = Len(Trimmed_String) Acroymn = UCase(Left(Trimmed_String, 1)) For Pos = 2 To Length - 1 If (Mid(Trimmed_String, Pos, 1) = " ") Then Acroymn = Acroymn & UCase(Mid(Trimmed_String, Pos + 1, 1)) End If Next Pos End Function
So for example :
Acroymn (“British Broadcasting Corporation”) gives BBC
Acroymn (“Funky”) gives F
Acroymn (“”) gives NULL
To download the .XLSM file from the article, click here



Hi,
This is a little faster.
[vb]
Function Acroymn2(Text) As String
Dim strReturn As String
Dim Item As Variant
For Each Item In Split(Text, ” “)
strReturn = strReturn & Left(Item, 1)
Next
Acroymn2 = UCase(strReturn)
End Function
[/vb]
hopefully code tags work