This function returns a string that is formatted in proper title case.
TitleCase(strString)
strString is any string that should be formatted into tile case. The
function will return a string formatted in title case. Exceptions to the
rules can be found inside of the function on the lines for strExcluded and
strKeywords.
The function will grow with additions to the lines for excluded keywords and
capitalized keywords.
The excluded keywords are those words that should not be capitalized unless
they are the first or last word of the string. To add a word to this list,
include it on the line for strExcluded inside of the quotation marks with a
space around it.
The capitalized keywords are those words in the title that should be in all
caps. For example, MMRF. These keywords should be included in the
strCapKeywords inside of the quotation marks with the first letter
capitalized and all remaining letters lower case. There should also be a
space around each keyword.
<%
Function TitleCase (strString)
Dim tmpString, z, strExcluded, strCapKeywords, strSpacers, strNewString, _
strCompare, intCapPosition, tmpNewLine
strExcluded = "with when and or a an the from to on as of in at for will"
strCapKeywords = "Nra Scuba Naacp"
strSpacers = " `~!@#$%^&*()-_=+[{]}\|;:',<.>/?'"
strString = Trim(strString)
if strString = "" then exit function
tmpCompareString = ""
for z = 1 to Len(strString)
strCompare = Mid(strString, z, 1)
if Instr(Ucase(strSpacers), Ucase(strCompare)) > 0 then
if Len(tmpString) = 0 then
strNewString = strNewString & strCompare
elseif Len(tmpString) = 1 then
if tmpString = "S" or tmpString = "T" then
strNewString = strNewString & Lcase(tmpString) & strCompare
else
strNewString = strNewString & tmpString & strCompare
end if
elseif Len(tmpString) > 1 then
if Instr(Ucase(strExcluded), Ucase(tmpString)) > 0 then
if strNewString = "" or tmpNewLine = True then
strNewString = strNewString & Ucase(left(tmpString, 1)) &
Lcase(right(tmpString, len(tmpString) - 1)) & strCompare
else
strNewString = strNewString & Lcase(tmpString) & strCompare
end if
else
strNewString = strNewString & Ucase(left(tmpString, 1)) &
Lcase(right(tmpString, len(tmpString) - 1)) & strCompare
end if
end if
if strCompare = ":" or StrCompare = ";" then tmpNewLine = True else
tmpNewLine = False
tmpString = ""
else
tmpString = tmpString & strCompare
end if
next
if Len(tmpString) = 0 then
strNewString = strNewString
elseif Len(tmpString) = 1 then
if tmpString = "S" or tmpString = "T" then
strNewString = strNewString & Lcase(tmpString) & strCompare
else
strNewString = strNewString & tmpString & strCompare
end if
elseif Len(tmpString) > 1 then
if Instr(Ucase(strExcluded), Ucase(tmpString)) > 0 then
if strNewString = "" then
strNewString = strNewString & Ucase(left(tmpString, 1)) &
Lcase(right(tmpString, len(tmpString) - 1))
else
strNewString = strNewString & Lcase(tmpString)
end if
else
strNewString = strNewString & Ucase(left(tmpString, 1)) &
Lcase(right(tmpString, len(tmpString) - 1))
end if
end if
tmpString = ""
for z = 1 to Len(strCapKeywords)
strCompare = Mid(strCapKeywords, z, 1)
if strCompare = " " then
strNewString = Replace(strNewString, tmpString, Ucase(tmpString))
tmpString = ""
else
tmpString = tmpString & strCompare
end if
next
if tmpString <> "" then
strNewString = Replace(strNewString, tmpString, Ucase(tmpString))
end if
TitleCase = Trim(strNewString)
end Function
%>
Submitted by Ben Kubs
