'Function to proper case a string and fix simple grammatical errors
Public function properCase(byVal strInput)
Dim lngStringLength 'Holds length of string
Dim strTemp 'Holds temporary string
Dim strTemp2 'Secondary temp
Dim intWordsToCheck 'Number of words to check
Dim strSpellingErrors(7) 'Spelling errors array
Dim strSpellingFix(7) 'Spelling fixes
Dim intLengthOfError 'Holds length of error
Dim intArraySize 'Array size for convenience
'Initialise
intWordsToCheck = 0
strSpellingErrors(0) = "isnt"
strSpellingFix(0) = "isn't"
strSpellingErrors(1) = "alot"
strSpellingFix(1) = "a lot"
strSpellingErrors(2) = "its"
strSpellingFix(2) = "it's"
strSpellingErrors(3) = "theyre"
strSpellingFix(3) = "they're"
strSpellingErrors(4) = "whos"
strSpellingFix(4) = "who's"
strSpellingErrors(5) = "dont"
strSpellingFix(5) = "don't"
strSpellingErrors(6) = "lets"
strSpellingFix(6) = "let's"
strSpellingErrors(7) = "thier"
strSpellingFix(7) = "their"
intArraySize = 7
intArraySize = intArraySize + 1
'Set entire string to lower case
strInput = trim(lCase(strInput))
'Replace little i with I
strInput = replace(strInput," i "," I ")
'Common grammatical error fixes
'MID SENTENCE
intWordsToCheck = 0
Do until intWordsToCheck = intArraySize
strInput = replace(strInput," " & strSpellingErrors(intWordsToCheck) & " "," " & strSpellingFix(intWordsToCheck) & " ")
'Add to counter
intWordsToCheck = intWordsToCheck + 1
Loop

'Loop through all errors and fixes
'SENTENCE START
intWordsToCheck =0
Do until intWordsToCheck = intArraySize
'Get properties
intLengthOfError = len(strSpellingErrors(intWordsToCheck)) + 1
If left(strInput,intLengthOfError) = strSpellingErrors(intWordsToCheck) & " " then
lngStringLength = len(strInput)
strTemp = right(strInput,lngStringLength-intLengthOfError)
strInput = strSpellingFix(intWordsToCheck) & " " & strTemp
End if
'Add to counter
intWordsToCheck = intWordsToCheck + 1
Loop
'Loop through all errors and fixes
'SENTENCE END
intWordsToCheck =0
Do until intWordsToCheck = intArraySize
'Get properties
intLengthOfError = len(strSpellingErrors(intWordsToCheck)) + 1
If right(strInput,intLengthOfError) = " " & strSpellingErrors(intWordsToCheck) then
lngStringLength = len(strInput)
strTemp = left(strInput,lngStringLength-intLengthOfError)
strInput = strTemp & " " & strSpellingFix(intWordsToCheck)
'Check for full stops, etc
Else
'Get properties
intLengthOfError = len(strSpellingErrors(intWordsToCheck)) + 2
If right(strInput,intLengthOfError) = " " & strSpellingErrors(intWordsToCheck) & "." OR right(strInput,intLengthOfError) = " " & strSpellingErrors(intWordsToCheck) & "?" OR right(strInput,intLengthOfError) = " " & strSpellingErrors(intWordsToCheck) & "!" OR right(strInput,intLengthOfError) = " " & strSpellingErrors(intWordsToCheck) & ":" OR right(strInput,intLengthOfError) = " " & strSpellingErrors(intWordsToCheck) & ";" then
lngStringLength = len(strInput)
strTemp2 = right(strInput,1)
strTemp = left(strInput,lngStringLength-intLengthOfError)
strInput = strTemp & " " & strSpellingFix(intWordsToCheck) & strTemp2
End if
End if
'Add to counter
intWordsToCheck = intWordsToCheck + 1
Loop
'Check for a full stop
strTemp = right(strInput,1)
If strTemp <> "?" AND strTemp <> "!" AND strTemp <> "." AND strTemp <> """" AND strTemp <> ":" AND strTemp <> ";" AND strTemp <> "'" then

strInput = strInput & "."
End if

'Get length
lngStringLength = len(strInput)
'Set temp
strTemp = right(strInput,lngStringLength-1)
'Set first letter
strInput = uCase(left(strInput,1))
'Reset
strInput = strInput & strTemp

'Return value
properCase = strInput
End function