I wrote a couple functions many years back to solve this exact problem. The basic technique is that there is a first function which breaks up a string into separate words and stores each word as an array element. Then a the code loops through each array element and converts the first letter of each word to upper case.
There are a couple nice features about the code. There's a string variable which holds each character that could be considered a word ending. For example "steve_pupel" or "steve.pupel" ... they _ or the . are considered word ending characters so that in both cases the S and the P will be converted to upper case.
Also there's a list of special words that should be all caps, like "usa" my code will convert that to USA. If the word has no vowels, then the code assumes it's an acronym and converts the entire word to upper.
Function Proper(TextString As String) As String
Dim aWord(40) As String
Dim aWordEndingCharacter(40) As String
Dim BuildString As String, PreviousCharacter As String, CurrentCharacter As String
Dim CapPriorToList As String ' Function should capitalize letters following any character in this string
Dim i As Integer, WordCounter As Integer, PreviousWordEnding As Integer, StringLength As Integer
Dim EnglishAlphabet As String
CapPriorToList = " `~.,()*!@&/|\_"
EnglishAlphabet = "abcdefghijklmnopqrstuvwxyz"
BuildString = ""
PreviousCharacter = " "
WordCounter = 1
PreviousWordEnding = 0
For i = 1 To Len(Trim(TextString))
CurrentCharacter = Mid(TextString, i, 1)
'If InStr(1, CapPriorToList, CurrentCharacter) <> 0 Then
If InStr(1, EnglishAlphabet, CurrentCharacter) = 0 Then
If PreviousWordEnding + 1 = i Then
aWord(WordCounter) = CurrentCharacter
Else
StringLength = i - PreviousWordEnding - 1
aWord(WordCounter) = Mid(TextString, PreviousWordEnding + 1, StringLength)
WordCounter = WordCounter + 1
aWord(WordCounter) = CurrentCharacter
End If
PreviousWordEnding = i
WordCounter = WordCounter + 1
Else
If i = Len(Trim(TextString)) Then
StringLength = i - PreviousWordEnding
aWord(WordCounter) = Mid(TextString, PreviousWordEnding + 1, StringLength)
End If
End If
Next i
For i = 1 To WordCounter
BuildString = BuildString & SimpleProper(aWord(i))
Next i
Proper = BuildString
End Function
Function SimpleProper(TextString As String) As String
Dim WordList As String
Dim WordListContinue As Boolean
Dim WordListPosition As Integer, WordListEndPosition As Integer, WordList2Position As Integer
Dim CurrentWordFromList As String
Dim WordIsInWordList As Boolean
Dim TwoCharacterWordStartList As String, wordlist2 As String
' This code written by self proclaimed computer genius, Steve Pupel
TwoCharacterWordStartList = "Mc**"
WordList = ";II;III;IV;VI;SIP;FAA;VAT;DD;OTCA;PV;BV;MGA;BIW;SQ;UK;USA;RJVI;LLC;IBA;PO;"
wordlist2 = ";St;Ct;th;Dr;Fl"
WordListContinue = True
WordListPosition = 1
WordIsInWordList = False
If InStr(1, WordList, ";" & Trim(TextString) & ";") = 0 Then
WordList2Position = InStr(1, wordlist2, ";" & Trim(TextString) & ";")
If WordList2Position = 0 Then
If Len(TextString) = 0 Then
SimpleProper = ""
Else
If InStr(1, TextString, "a") = 0 And InStr(1, TextString, "e") = 0 And InStr(1, TextString, "i") = 0 And InStr(1, TextString, "o") = 0 And InStr(1, TextString, "u") = 0 And InStr(1, TextString, "y") = 0 Then
SimpleProper = UCase(TextString)
Else
WordListPosition = InStr(1, TwoCharacterWordStartList, Left(TextString, 2))
If WordListPosition <> 0 And Len(Trim(TextString)) > 2 Then
SimpleProper = Mid(TwoCharacterWordStartList, WordListPosition, 2) & UCase(Mid(TextString, 3, 1)) & LCase(Mid(TextString, 4, Len(TextString) - 3))
Else
SimpleProper = UCase(Left(TextString, 1)) & LCase(Mid(TextString, 2, Len(TextString) - 1))
End If
End If
End If
Else
SimpleProper = Mid(wordlist2, WordList2Position + 1, Len(Trim(TextString)))
End If
Else
SimpleProper = UCase(TextString)
End If
End Function
