Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Title Case: Not Just Capitalizing the First Letter of Each Word 2

Status
Not open for further replies.
Carrion

Carrion

Technical User
Jul 26, 2002
27
US
I was searching today for a VBA script to take care of those words that are not supposed to be capitalized in the title of a book. I work in a library, and am typing them on a regular basis.

I could not find one that was any good. So I gave up and wrote on myself (I hope others will put it to use):

Private Function TitleCase(Title)
Dim OriginalBookName As String
Dim BookNameHold As String
Dim BookNameHold2 As String
Dim One As String
Dim Two As String
Dim SearchWord As String
Dim FoundOne As Boolean
Dim BookName As String
If IsNull(Title) = True Or Title = "" Then Exit Function
BookName = Title
DoubleSpace:
If InStr(1, BookName, " ") > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, " ")) & Mid(BookName, InStr(1, BookName, " ") + 2, 100000)
GoTo DoubleSpace
End If
OriginalBookName = Trim(BookName)
BookName = " " & LCase(BookName) & " "
Topper2:
If InStr(1, Mid(BookName, 1, 1), UCase(Mid(BookName, 1, 1)), 0) > 0 And Not Mid(BookName, 1, 1) = "'" Then
BookNameHold2 = BookNameHold2 & " "
Else
BookNameHold2 = BookNameHold2 & Mid(BookName, 1, 1)
End If
BookName = Mid(BookName, 2, 1000000)
If Len(BookName) > 0 Then GoTo Topper2
BookName = BookNameHold2
Topper:
One = Mid(BookName, 1, 2)
Two = UCase(Mid(BookName, 1, 1)) & Mid(BookName, 2, 1)
If InStr(1, One, Two, 0) > 0 And Not Mid(BookName, 1, 1) = "'" Then
BookNameHold = BookNameHold & UCase(Mid(BookName, 2, 1))
Else
BookNameHold = BookNameHold & Mid(BookName, 2, 1)
End If
BookName = Mid(BookName, 2, 1000000)
If Len(BookName) > 0 Then GoTo Topper
BookName = BookNameHold
TheTopps:
FoundOne = False
SearchWord = " A "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Aboard "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " About "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Above "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Across "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " After "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Against "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Along "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Amid "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Among "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " An "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " And "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Anti "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Around "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " As "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " At "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Before "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Behind "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Below "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Beneath "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Beside "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Besides "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Between "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Beyond "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " But "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " By "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Concerning "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Considering "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Despite "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Down "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " During "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Except "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Excepting "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Excluding "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Following "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " For "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " From "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " In "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Inside "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Into "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Like "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Minus "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Near "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Nor "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Of "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Off "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " On "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Onto "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Opposite "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Or "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Outside "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Over "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Past "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Per "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Plus "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Regarding "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Round "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Save "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Since "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Than "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " The "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Through "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " To "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Toward "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Towards "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Under "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Underneath "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Unlike "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Until "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Up "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Upon "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Versus "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Via "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Vs "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " With "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Within "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
SearchWord = " Without "
If InStr(1, BookName, SearchWord, 0) > 0 Then
BookName = Mid(BookName, 1, InStr(1, BookName, SearchWord, 0) - 1) & LCase(SearchWord) & Mid(BookName, InStr(1, BookName, SearchWord, 0) + Len(SearchWord), 1000000)
FoundOne = True
End If
If FoundOne = True Then GoTo TheTopps
Dim counter As Integer
LastOne:
counter = counter + 1
If Mid(BookName, Len(BookName) - counter, 1) = " " Then
BookName = Mid(BookName, 1, Len(BookName) - counter) & UCase(Mid(BookName, Len(BookName) - counter + 1, 1)) & Mid(BookName, Len(BookName) - counter + 2, 1000000)
Else
GoTo LastOne
End If
BookName = Trim(BookName)
Dim PutBackIn As String
TheTopAgain:
If Mid(BookName, 1, 1) = " " Then
PutBackIn = PutBackIn & Mid(OriginalBookName, 1, 1)
Else
PutBackIn = PutBackIn & Mid(BookName, 1, 1)
End If
OriginalBookName = Mid(OriginalBookName, 2, 1000000)
BookName = Mid(BookName, 2, 1000000)
If Len(BookName) > 0 Then GoTo TheTopAgain
BookName = " " & PutBackIn & " "
counter = 0
LastOne2:
counter = counter + 1
If Mid(BookName, Len(BookName) - counter, 1) = " " Then
BookName = Mid(BookName, 1, Len(BookName) - counter) & UCase(Mid(BookName, Len(BookName) - counter + 1, 1)) & Mid(BookName, Len(BookName) - counter + 2, 1000000)
Else
GoTo LastOne2
End If
BookName = Trim(BookName)
'BookName = BookNameHold2
BookName = Trim(BookName)
BookName = UCase(Mid(BookName, 1, 1)) & Mid(BookName, 2, 100000)
Dim Titlebuilder As String
FindCols:
If Mid(BookName, 1, 2) = ": " Then BookName = UCase(Mid(BookName, 1, 3)) & Mid(BookName, 4, 100000)
Titlebuilder = Titlebuilder & Mid(BookName, 1, 1)
BookName = Mid(BookName, 2, 1000000)
If Len(BookName) > 0 Then GoTo FindCols
Title = Titlebuilder
End Function
 
Hi Carrion,

You could reduce the amount of code and make it easier to maintain with:
Code: 
Private Function TitleCase(Title)
Dim OriginalBookName As String
Dim BookNameHold As String
Dim BookNameHold2 As String
Dim counter As Integer
Dim One As String
Dim Two As String
Dim SearchWord As String
Dim SearchWords As String
Dim FoundOne As Boolean
Dim BookName As String
Dim PutBackIn As String
Dim i As Integer
SearchWords = "A,Aboard,About,Above,Across,After,Against,Along,Amid,Among,An,And,Anti,Around,As,At,"
SearchWords = SearchWords & "Before,Behind,Below,Beneath,Beside,Besides,Between,Beyond,But,By,"
SearchWords = SearchWords & "Concerning,Considering,Despite,Down,During,Except,Excepting,Excluding,"
SearchWords = SearchWords & "Following,For,From,In,Inside,Into,Like,Minus,Near,Nor,Of,Off,On,Onto,"
SearchWords = SearchWords & "Opposite,Or,Outside,Over,Past,Per,Plus,Regarding,Round,Save,Since,"
SearchWords = SearchWords & "Than,The,Through,To,Toward,Towards,Under,Underneath,Unlike,Until,Up,Upon,"
SearchWords = SearchWords & "Versus,Via,Vs,With,Within,Without"
If IsNull(Title) = True Or Title = "" Then Exit Function
BookName = Trim(Title)
DoubleSpace:
If InStr(1, BookName, "  ") > 0 Then
  BookName = Replace(BookName, "  ", " ")
  GoTo DoubleSpace
End If
OriginalBookName = BookName
BookName = " " & LCase(BookName) & " "
Topper2:
If InStr(1, Mid(BookName, 1, 1), UCase(Mid(BookName, 1, 1)), 0) > 0 And Not Mid(BookName, 1, 1) = "'" Then
  BookNameHold2 = BookNameHold2 & " "
Else
  BookNameHold2 = BookNameHold2 & Mid(BookName, 1, 1)
End If
BookName = Mid(BookName, 2, 1000000)
If Len(BookName) > 0 Then GoTo Topper2
BookName = BookNameHold2
Topper:
One = Mid(BookName, 1, 2)
Two = UCase(Mid(BookName, 1, 1)) & Mid(BookName, 2, 1)
If InStr(1, One, Two, 0) > 0 And Not Mid(BookName, 1, 1) = "'" Then
  BookNameHold = BookNameHold & UCase(Mid(BookName, 2, 1))
Else
  BookNameHold = BookNameHold & Mid(BookName, 2, 1)
End If
BookName = Mid(BookName, 2, 1000000)
If Len(BookName) > 0 Then GoTo Topper
BookName = BookNameHold
TheTopps:
FoundOne = False
For i = 1 To UBound(Split(SearchWords, ","))
  SearchWord = " " & Split(SearchWords, ",")(i) & " "
  If InStr(1, BookName, SearchWord, 0) > 0 Then
    BookName = Replace(BookName, SearchWord, LCase(SearchWord))
    FoundOne = True
  End If
Next i
If FoundOne = True Then GoTo TheTopps
LastOne:
counter = counter + 1
If Mid(BookName, Len(BookName) - counter, 1) = " " Then
BookName = Mid(BookName, 1, Len(BookName) - counter) & UCase(Mid(BookName, Len(BookName) - counter + 1, 1)) & Mid(BookName, Len(BookName) - counter + 2, 1000000)
Else
GoTo LastOne
End If
BookName = Trim(BookName)
TheTopAgain:
If Mid(BookName, 1, 1) = " " Then
PutBackIn = PutBackIn & Mid(OriginalBookName, 1, 1)
Else
PutBackIn = PutBackIn & Mid(BookName, 1, 1)
End If
OriginalBookName = Mid(OriginalBookName, 2, 1000000)
BookName = Mid(BookName, 2, 1000000)
If Len(BookName) > 0 Then GoTo TheTopAgain
BookName = " " & PutBackIn & " "
counter = 0
LastOne2:
counter = counter + 1
If Mid(BookName, Len(BookName) - counter, 1) = " " Then
BookName = Mid(BookName, 1, Len(BookName) - counter) & UCase(Mid(BookName, Len(BookName) - counter + 1, 1)) & Mid(BookName, Len(BookName) - counter + 2, 1000000)
Else
GoTo LastOne2
End If
BookName = Trim(BookName)
'BookName = BookNameHold2
BookName = Trim(BookName)
BookName = UCase(Mid(BookName, 1, 1)) & Mid(BookName, 2, 100000)
Dim Titlebuilder As String
FindCols:
If Mid(BookName, 1, 2) = ": " Then BookName = UCase(Mid(BookName, 1, 3)) & Mid(BookName, 4, 100000)
Titlebuilder = Titlebuilder & Mid(BookName, 1, 1)
BookName = Mid(BookName, 2, 1000000)
If Len(BookName) > 0 Then GoTo FindCols
TitleCase = Titlebuilder
End Function
There may be other optimisations too, but I haven't looked at everything in detail.


Cheers
[MS MVP - Word]
 



Rather than hard code each individual exception word into your VBA, enter them in a table.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 

I agree with Skip, but even with all exception words in the code, you can make it a lot simpler:
Code: 
Private Function TitleCase(strTitle As String) As String
Dim strExceptions As String
Dim aryTitle() As String
Dim strOutcoms As String
Dim i As Integer

strExceptions = "*A*Aboard*About*Above*Across*After*Against*Along*Amid*Among*An*And*Anti*Around*As*At*"

aryTitle = Split(strTitle, " ")

For i = 0 To UBound(aryTitle)
    If InStr(UCase(strExceptions), "*" & UCase(aryTitle(i)) & "*") Then[green]
        'word needs to be in small letters[/green]
        aryTitle(i) = LCase(aryTitle(i))
    Else[green]
        'Word Needs To Be Capitalized[/green]
        aryTitle(i) = StrConv(aryTitle(i), vbProperCase)
    End If
    
    If i = 0 Then[green]
        'Always Capitalize First Word[/green]
        aryTitle(i) = StrConv(aryTitle(i), vbProperCase)
    End If
Next i

For i = 0 To UBound(aryTitle)
    strOutcoms = strOutcoms & aryTitle(i) & " "
Next i

TitleCase = Left(strOutcoms, Len(strOutcoms) - 1)

End Function
Of course you need to add to this some other logic (like a period at the end of the title) but the code may be a lot simpler than the original.

Have fun.

---- Andy
 
Rather than hard code each individual exception word into your VBA, enter them in a table. "

Or a simple text file. That would make it easier to maintain as well.

PS, is there a way to change this from a WIDE thread? I can not see a lot of it.

Carrion, please use the TGML code tags when posting code. Thanks.

"A little piece of heaven
without that awkward dying part."

advertisment for Reese's Peanut Butter Cups (a chocolate/peanut butter confection)

Gerry
 
Hi Gerry,

For the OP's needs, I doubt that holding the exceptions in a separate text file would help much. That's because the list should remain pretty stable.


Cheers
[MS MVP - Word]
 
I wish I could read your post, macropod. It disappears off to the right.

WHAT remains stable?????

"A little piece of heaven
without that awkward dying part."

advertisment for Reese's Peanut Butter Cups (a chocolate/peanut butter confection)

Gerry
 
Hi Gerry,
WHAT remains stable?????
Click to expand...
The list of exception words.

As for the reading problems, I can see all of what I posted, so I don't know why there's a problem at your end.


Cheers
[MS MVP - Word]
 
What I see from your last post, with NO way to scroll...
As for the reading problems, I can see all of what I posted, so I don't know why there's a proble
Click to expand...

In any case, what I meant by holding it in a text file was to avoid having all that hard coded stuff. No big deal.

"A little piece of heaven
without that awkward dying part."

advertisment for Reese's Peanut Butter Cups (a chocolate/peanut butter confection)

Gerry
 
Gerry, I had that a year or so ago. Also a few issues with other sites. I found that using IE for problem sites solved the problem. So - I reckon a browser issue.

In Firefox 3.0.3 the wrapping adapts to the width until you get to a certain window size then scroll bars appear.

Gavin
 
I wish I could go to Firefox, but that is not possible as our machines at work are pretty locked down. I no longer have internet access at home, so I am stuck with IE.

"A little piece of heaven
without that awkward dying part."

advertisment for Reese's Peanut Butter Cups (a chocolate/peanut butter confection)

Gerry
 
Hey, if someone wants to make this better, feel free. I don't have the time to so.... I was given a half hour to design a program for a non-native english speaker, who has problems with the intricacies of sentence structure, that would build and upload a webpage to an ftp server. This way new list of books can be updated at any point. There are only 4 rules to proper title capitalization, and I don't have a problem with them. I guess I didn't see the point in spending too much time on an issue that I will never run into myself. But hack and slash this thing to pieces if you feel like it. I was just surprised not to find anything pre-built in VBA that I could rip off.
 


Carrion,

I notice that over the past 7 years, you have posted 21 threads and have received many good tips related to your stated needs. Yet, you have responded NOT ONCE, to
[blue]
Thank Tek-Tip Contributor
for this valuable post![/blue].

The [purple]little purple Stars[/purple] accomplish several important things.

First, it gives positive feedback to contributors, that their posts have been helpful.

Second, it identifies threads as containing helpful posts, so that other members can benefit.

And third, it identifies the original poster (that's YOU, BTW), as a grateful member, that not only receives, but is willing to give tokens of thanks.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Status
Not open for further replies.

Similar threads

Andrzejek
  • Question
Hyperlinks in Word cut at #
Replies
2
Views
105
Andrzejek
Andrzejek
remeng
  • Locked
  • Helpful tip
Microsoft Office 365 Word Macro Causing a Project is unviewable error
Replies
1
Views
825
dhookom
dhookom
remeng
  • Locked
  • Solved
Combine two working macros into one for MS Word 1
Replies
7
Views
788
strongm
strongm
morechocolate
  • Locked
  • Question
run-tune error 3704 operation is not allowed when the object is codes: I don't think so.
Replies
7
Views
889
morechocolate
morechocolate
remeng
  • Locked
  • Solved
Run-time error '429': ActiveX component can't create object From Excel to Word
Replies
9
Views
928
remeng
remeng

Part and Inventory Search

Sponsor

Back
Top