Main Sub - Loop through a range of cells (Call Functions)
(See: Split for Alternate [Split] method using 2 Delimiters)
Required functions (x5) (Scroll down for code)
- ChooseCapitals
- Cap1_LoadDelLocAndValString
- Cap2_ReplaceDelimiters
- Cap3_SplitAndReview
- Cap4_RestoreDelimiters
Sub ReviewColumnList()
Dim Ws1 As Long, iLoop As Long, sThisString As String, iWordCount As Long, iUbound As Long, aData() As Variant, aDump() As Variant, iRe1 As Long, iCe1 As Long, iCol As Long
Dim sConcat As String
Dim sDelimter As String, sTempDel As String
Dim sSpace As String, sPipe As String, sComma As String, sColon As String
'---------------------------------------
Dim sAllDelim As String
Dim sPosDel As String 'h
Dim sWordKaret As String 'i
Dim sWordCapsApplied As String 'j
Dim sWordInProgress As String
'---------------------------------------
sAllDelim = " |,:^"
'---------------------------------------
sTempDel = "~"
Ws1 = Worksheets("Sheet4").Index
iRe1 = Worksheets(Ws1).Cells(1048576, 1).End(xlUp).Row
iCe1 = Worksheets(Ws1).Cells(2, 300).End(xlToLeft).Column
'===================================================================================================
Worksheets(Ws1).Select
aData = Range(Worksheets(Ws1).Cells(1, 1).Address, Worksheets(Ws1).Cells(iRe1, iCe1).Address)
'===================================================================================================
'TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
'Template Example:
'Use the method between the "T"s to loop through a column and apply Capitalization
'(Note: If source strings are ALL CAPS, it will not work correctly)
'TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
'Review each CELL value
For iLoop = LBound(aData) To UBound(aData)
sThisString = aData(iLoop, 1)
'|,^7|| ^8||,^13|| ^14| Create the string containing the Positions + Values of Delimiters
sPosDel = Cap1_LoadDelLocAndValString(sThisString, sAllDelim)
'orange^^blue^^black Change all the delimiters to "^"
sWordInProgress = Cap2_ReplaceDelimiters(sThisString, sAllDelim)
'Orange^^Blue^^Black Apply the Capitalization using the standard delimiter [^]
sWordInProgress = Cap3_SplitAndReview(sWordInProgress, "^")
'Orange, Blue, Black Restore the Original Delimiters using the [Pos|Val(sPosDel)] string
sWordInProgress = Cap4_RestoreDelimiters(sWordInProgress, sPosDel)
sThisString = Replace(sThisString, sWordInProgress, sWordInProgress, , , vbTextCompare)
Debug.Print iLoop & "#: =" & sThisString
Next iLoop
'TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
Erase aData: Erase aDump
End Sub
Dim Ws1 As Long, iLoop As Long, sThisString As String, iWordCount As Long, iUbound As Long, aData() As Variant, aDump() As Variant, iRe1 As Long, iCe1 As Long, iCol As Long
Dim sConcat As String
Dim sDelimter As String, sTempDel As String
Dim sSpace As String, sPipe As String, sComma As String, sColon As String
'---------------------------------------
Dim sAllDelim As String
Dim sPosDel As String 'h
Dim sWordKaret As String 'i
Dim sWordCapsApplied As String 'j
Dim sWordInProgress As String
'---------------------------------------
sAllDelim = " |,:^"
'---------------------------------------
sTempDel = "~"
Ws1 = Worksheets("Sheet4").Index
iRe1 = Worksheets(Ws1).Cells(1048576, 1).End(xlUp).Row
iCe1 = Worksheets(Ws1).Cells(2, 300).End(xlToLeft).Column
'===================================================================================================
Worksheets(Ws1).Select
aData = Range(Worksheets(Ws1).Cells(1, 1).Address, Worksheets(Ws1).Cells(iRe1, iCe1).Address)
'===================================================================================================
'TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
'Template Example:
'Use the method between the "T"s to loop through a column and apply Capitalization
'(Note: If source strings are ALL CAPS, it will not work correctly)
'TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
'Review each CELL value
For iLoop = LBound(aData) To UBound(aData)
sThisString = aData(iLoop, 1)
'|,^7|| ^8||,^13|| ^14| Create the string containing the Positions + Values of Delimiters
sPosDel = Cap1_LoadDelLocAndValString(sThisString, sAllDelim)
'orange^^blue^^black Change all the delimiters to "^"
sWordInProgress = Cap2_ReplaceDelimiters(sThisString, sAllDelim)
'Orange^^Blue^^Black Apply the Capitalization using the standard delimiter [^]
sWordInProgress = Cap3_SplitAndReview(sWordInProgress, "^")
'Orange, Blue, Black Restore the Original Delimiters using the [Pos|Val(sPosDel)] string
sWordInProgress = Cap4_RestoreDelimiters(sWordInProgress, sPosDel)
sThisString = Replace(sThisString, sWordInProgress, sWordInProgress, , , vbTextCompare)
Debug.Print iLoop & "#: =" & sThisString
Next iLoop
'TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
Erase aData: Erase aDump
End Sub
Main Function: Review Individual Word (+Handle [Dashes])
Function ChooseCapitals(myWord As Variant) As String
'https://english.stackexchange.com/questions/14/which-words-in-a-title-should-be-capitalized
On Error GoTo gFoundAnError
Dim sWord As String
Dim sChar2 As String, sChar3 As String
Dim sLowerConcat As String, sProperConcat As String
Dim sRemoveIV As String
Dim iWordLen As Long, iLoop As Long, aSplitMe As Variant
'============================================================================================
sWord = myWord
iWordLen = Len(sWord)
'============================================================================================
'These decisions (1-3) do not require the Word List Strings to be loaded (Saves memory/Increases Speed: by NOT loading first)
'2)============================================================================================
'If the string contains a [Dash], convert it to UPPER case - No Further Review
If sWord Like "*-*" Then GoTo gHandleDashes
'1)============================================================================================
'If the string contains ANY number, convert it to UPPER case - No Further Review
If sWord Like "*#*" Then GoTo gForceUpper
'3)============================================================================================
'Remove Char[I]&[V] from the string: If the len(NewWord) = 0, then [I]&[V] are the ONLY characters in the string
sRemoveIV = Replace(sWord, "i", "", , , vbTextCompare)
sRemoveIV = Replace(sRemoveIV, "v", "", , , vbTextCompare)
If Len(sRemoveIV) = 0 Then GoTo gRomanNumerals
'============================================================================================
'In the Order Of Operations, the next 2 decisions (4-5) require the loading of the Word List Strings
'============================================================================================
'Force [lower][Proper]
sLowerConcat = "^am^an^and^as^at^but^by^do^for^he^if^in^is^it^me^nor^of^on^or^so^the^to^lbs^lbs.^oz^oz.^per^cm^"
sProperConcat = "^a^i^God^Jew^"
'============================================================================================
'String List [Words less than 4 characters]
sChar2 = "^a^i^am^an^ar^as^at^be^by^do^go^he^hi^if^in^is^it^me^my^no^of^on^or^ox^so^to^up^us^we^"
sChar3 = "^abs^ace^act^add^ado^ads^aft^age^ago^aid^ail^aim^air^ale^all^amp^and^ant^any^ape^apt^arc^are^ark^arm^art^ash^ask^asp^ass^ate^awe^awl^axe^baa^bad^bag^bah^bam^ban^bar^bat^bay^bed^bee^beg^bet^"
sChar3 = sChar3 & "^bey^bib^bid^big^bin^bio^bit^boa^bob^bod^bog^boo^bop^bow^box^boy^bra^bro^bub^bud^bug^bum^bun^bus^but^buy^bye^cab^cad^cam^can^cap^car^cat^caw^cee^cha^chi^cob^cod^cog^con^coo^cop^cot^cow^"
sChar3 = sChar3 & "^cox^coy^cry^cub^cud^cue^cup^cur^cut^dab^dad^dag^dam^day^dee^den^dew^dib^did^die^dig^dim^din^dip^doe^dog^don^doo^dop^dot^dry^dub^dud^due^dug^duh^dun^duo^dux^dye^ear^eat^ebb^eel^egg^ego^"
sChar3 = sChar3 & "^eke^elf^elk^elm^emo^emu^end^eon^era^erg^err^eve^ewe^eye^fab^fad^fag^fan^far^fat^fax^fay^fed^fee^fen^few^fey^fez^fib^fie^fig^fin^fir^fit^fix^fly^fob^foe^fog^fon^fop^for^fox^fry^fun^fur^"
sChar3 = sChar3 & "^ab^gag^gak^gal^gap^gas^gaw^gay^gee^gel^gem^get^gig^gil^gin^git^gnu^gob^God^goo^got^gum^gun^gut^guy^gym^had^hag^hal^ham^has^hat^hay^hem^hen^her^hew^hex^hey^hid^him^hip^his^hit^hoe^hog^"
sChar3 = sChar3 & "^hop^hot^how^hoy^hub^hue^hug^huh^hum^hut^ice^ick^icy^ilk^ill^imp^ink^inn^ion^ire^irk^jab^jag^jah^jak^jam^jap^jar^jaw^jay^jem^jet^Jew^jib^jig^job^joe^jog^jon^jot^joy^jug^jus^jut^keg^key^"
sChar3 = sChar3 & "^kid^kin^kit^koa^kob^koi^lab^lad^lag^lap^law^lax^lay^lea^led^leg^lei^let^lew^lid^lie^lip^lit^lob^log^loo^lop^lot^low^lug^lux^lye^mac^mad^mag^man^map^mar^mat^maw^max^may^men^met^mic^mid^"
sChar3 = sChar3 & "^mit^mix^mob^mod^mog^mom^mon^moo^mop^mow^mud^mug^mum^nab^nag^nap^nay^nee^neo^net^new^nib^nil^nip^nit^nix^nob^nod^nog^nor^not^now^nub^nun^nut^oaf^oak^oar^oat^odd^ode^off^oft^ohm^oil^old^"
sChar3 = sChar3 & "^ole^one^opt^orb^ore^our^out^ova^owe^owl^own^pac^pad^pal^pan^pap^par^pat^paw^pax^pay^pea^pee^peg^pen^pep^per^pet^pew^pic^pie^pig^pin^pip^pit^pix^ply^pod^pog^poi^poo^pop^pot^pow^pox^pro^"
sChar3 = sChar3 & "^pry^pub^pud^pug^pun^pup^pus^put^pyx^qat^qua^quo^rad^rag^ram^ran^rap^rat^raw^ray^red^rib^rid^rig^rim^rip^rob^roc^rod^roe^rot^row^rub^rue^rug^rum^run^rut^rye^sac^sad^sag^sap^sat^saw^sax^"
sChar3 = sChar3 & "^say^sea^sec^see^set^sew^sex^she^shy^sic^sim^sin^sip^sir^sis^sit^six^ski^sky^sly^sob^sod^som^son^sop^sot^sow^soy^spa^spy^sty^sub^sue^sum^sun^sup^tab^tad^tag^tam^tan^tap^tar^tax^tea^tee^"
sChar3 = sChar3 & "^ten^the^tic^tie^til^tin^tip^tit^toe^tom^ton^too^top^tot^tow^toy^try^tub^tug^tui^tut^two^ugh^uke^ump^urn^use^van^vat^vee^vet^vex^via^vie^vig^vim^voe^vow^wad^wag^wan^war^was^wax^way^web^"
sChar3 = sChar3 & "^wed^wee^wen^wet^who^why^wig^win^wit^wiz^woe^wog^wok^won^woo^wow^wry^wye^yak^yam^yap^yaw^yay^yea^yen^yep^yes^yet^yew^yip^you^yow^yum^yup^zag^zap^zed^zee^zen^zig^zip^zit^zoa^zoo^"
'============================================================================================
'4)============================================================================================
'If the string matches a word that is ALWAYS changed to LCase...
If InStr(1, sLowerConcat, "^" & sWord & "^", vbTextCompare) > 0 Then GoTo gForceLower
'5)============================================================================================
'If the string matches a word that is ALWAYS changed to Proper Case...
If InStr(1, sProperConcat, "^" & sWord & "^", vbTextCompare) > 0 Then GoTo gForceProper
'============================================================================================
'============================================================================================
'Handle Word Length (1-3) or (4+)
If iWordLen > 3 Then GoTo gCharLenIsFourOrMore
If iWordLen = 3 Then GoTo gCharLenIsThree
If iWordLen = 2 Then GoTo gCharLenIsTwo
If iWordLen = 1 Then GoTo gCharLenIsOne
If iWordLen = 0 Then GoTo gFinalDecision
'============================================================================================
'---------------------------------------------------------------------------------------------
Debug.Print "Pause - does a goto 'Finish' statement need to be inserted here? [" & myWord & "]"
'---------------------------------------------------------------------------------------------
'#############################################################################################
'#############################################################################################
'---------------------------------------------------------------------------------------------
gHandleDashes:
'Handle Strings with Dashes differently depending on if there is a NUMBER Present... or if the portion of the string is already ALL Ucase
'Use the dash to split into individual words - review and apply rules, then restore the dashes
sWord = Replace(sWord, "-", " ~ ", , , vbTextCompare) 'use tilde, not dash~!
aSplitMe = Split(sWord, " ~ ")
For iLoop = LBound(aSplitMe) To UBound(aSplitMe)
'Change to proper if the string is not UCASE already
If aSplitMe(iLoop) <> UCase(aSplitMe(iLoop)) Then sWord = Replace(sWord, aSplitMe(iLoop), StrConv(aSplitMe(iLoop), vbProperCase), , , vbTextCompare) If Len(aSplitMe(iLoop)) < 4 Then sWord = Replace(sWord, aSplitMe(iLoop), UCase(aSplitMe(iLoop)), , , vbTextCompare)
'Change to UCASE if there is a number in the string
If aSplitMe(iLoop) Like "*#*" Then sWord = Replace(sWord, aSplitMe(iLoop), UCase(aSplitMe(iLoop)), , , vbTextCompare)
Next iLoop
Erase aSplitMe
sWord = Replace(sWord, " ~ ", "-", , , vbTextCompare)
GoTo gFinalDecision
'---------------------------------------------------------------------------------------------
'3-Action)RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
'Word is Roman Numerals - convert to UPPER - no further review
gRomanNumerals:
GoTo gForceUpper
'RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
'4-6: Action)123123123123123123123123123123123123123123123123123123123123123123123123123123123123123123123
'If the String matches a valid word, Change to [Proper]. Otherwise, change it to [UPPER]
gCharLenIsThree:
If InStr(1, sChar3, sWord, vbTextCompare) > 0 Then GoTo gForceProper
GoTo gForceUpper
gCharLenIsTwo:
If InStr(1, sChar2, sWord, vbTextCompare) > 0 Then GoTo gForceProper
GoTo gForceUpper
gCharLenIsOne:
If InStr(1, sChar2, sWord, vbTextCompare) > 0 Then GoTo gForceProper
GoTo gForceUpper
gCharLenIsFourOrMore:
'IF it gets to this point, ALL decisions to handle exceptions have been made - the only choice is [Proper]
GoTo gForceProper
'123123123123123123123123123123123123123123123123123123123123123123123123123123123123123123123
'Convert) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Convert string to [lower]
gForceLower:
sWord = LCase(sWord)
GoTo gFinalDecision
'Convert string to [Proper]
gForceProper:
'Exception-------------------------------------------
'If the word is already all UCASE, leave it alone...
If sWord = UCase(sWord) And Len(sWord) > 3 Then GoTo gForceUpper
'Exception-------------------------------------------
sWord = StrConv(sWord, vbProperCase)
GoTo gFinalDecision
'Convert string to UPPER
gForceUpper:
sWord = UCase(sWord)
GoTo gFinalDecision
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
gFinalDecision:
ChooseCapitals = sWord
Exit Function
'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
gFoundAnError:
Debug.Print "Error occured when attempting to Choose Capitalization. Create Breakpoint and test for word [" & myWord & "]"
End Function
'https://english.stackexchange.com/questions/14/which-words-in-a-title-should-be-capitalized
On Error GoTo gFoundAnError
Dim sWord As String
Dim sChar2 As String, sChar3 As String
Dim sLowerConcat As String, sProperConcat As String
Dim sRemoveIV As String
Dim iWordLen As Long, iLoop As Long, aSplitMe As Variant
'============================================================================================
sWord = myWord
iWordLen = Len(sWord)
'============================================================================================
'These decisions (1-3) do not require the Word List Strings to be loaded (Saves memory/Increases Speed: by NOT loading first)
'2)============================================================================================
'If the string contains a [Dash], convert it to UPPER case - No Further Review
If sWord Like "*-*" Then GoTo gHandleDashes
'1)============================================================================================
'If the string contains ANY number, convert it to UPPER case - No Further Review
If sWord Like "*#*" Then GoTo gForceUpper
'3)============================================================================================
'Remove Char[I]&[V] from the string: If the len(NewWord) = 0, then [I]&[V] are the ONLY characters in the string
sRemoveIV = Replace(sWord, "i", "", , , vbTextCompare)
sRemoveIV = Replace(sRemoveIV, "v", "", , , vbTextCompare)
If Len(sRemoveIV) = 0 Then GoTo gRomanNumerals
'============================================================================================
'In the Order Of Operations, the next 2 decisions (4-5) require the loading of the Word List Strings
'============================================================================================
'Force [lower][Proper]
sLowerConcat = "^am^an^and^as^at^but^by^do^for^he^if^in^is^it^me^nor^of^on^or^so^the^to^lbs^lbs.^oz^oz.^per^cm^"
sProperConcat = "^a^i^God^Jew^"
'============================================================================================
'String List [Words less than 4 characters]
sChar2 = "^a^i^am^an^ar^as^at^be^by^do^go^he^hi^if^in^is^it^me^my^no^of^on^or^ox^so^to^up^us^we^"
sChar3 = "^abs^ace^act^add^ado^ads^aft^age^ago^aid^ail^aim^air^ale^all^amp^and^ant^any^ape^apt^arc^are^ark^arm^art^ash^ask^asp^ass^ate^awe^awl^axe^baa^bad^bag^bah^bam^ban^bar^bat^bay^bed^bee^beg^bet^"
sChar3 = sChar3 & "^bey^bib^bid^big^bin^bio^bit^boa^bob^bod^bog^boo^bop^bow^box^boy^bra^bro^bub^bud^bug^bum^bun^bus^but^buy^bye^cab^cad^cam^can^cap^car^cat^caw^cee^cha^chi^cob^cod^cog^con^coo^cop^cot^cow^"
sChar3 = sChar3 & "^cox^coy^cry^cub^cud^cue^cup^cur^cut^dab^dad^dag^dam^day^dee^den^dew^dib^did^die^dig^dim^din^dip^doe^dog^don^doo^dop^dot^dry^dub^dud^due^dug^duh^dun^duo^dux^dye^ear^eat^ebb^eel^egg^ego^"
sChar3 = sChar3 & "^eke^elf^elk^elm^emo^emu^end^eon^era^erg^err^eve^ewe^eye^fab^fad^fag^fan^far^fat^fax^fay^fed^fee^fen^few^fey^fez^fib^fie^fig^fin^fir^fit^fix^fly^fob^foe^fog^fon^fop^for^fox^fry^fun^fur^"
sChar3 = sChar3 & "^ab^gag^gak^gal^gap^gas^gaw^gay^gee^gel^gem^get^gig^gil^gin^git^gnu^gob^God^goo^got^gum^gun^gut^guy^gym^had^hag^hal^ham^has^hat^hay^hem^hen^her^hew^hex^hey^hid^him^hip^his^hit^hoe^hog^"
sChar3 = sChar3 & "^hop^hot^how^hoy^hub^hue^hug^huh^hum^hut^ice^ick^icy^ilk^ill^imp^ink^inn^ion^ire^irk^jab^jag^jah^jak^jam^jap^jar^jaw^jay^jem^jet^Jew^jib^jig^job^joe^jog^jon^jot^joy^jug^jus^jut^keg^key^"
sChar3 = sChar3 & "^kid^kin^kit^koa^kob^koi^lab^lad^lag^lap^law^lax^lay^lea^led^leg^lei^let^lew^lid^lie^lip^lit^lob^log^loo^lop^lot^low^lug^lux^lye^mac^mad^mag^man^map^mar^mat^maw^max^may^men^met^mic^mid^"
sChar3 = sChar3 & "^mit^mix^mob^mod^mog^mom^mon^moo^mop^mow^mud^mug^mum^nab^nag^nap^nay^nee^neo^net^new^nib^nil^nip^nit^nix^nob^nod^nog^nor^not^now^nub^nun^nut^oaf^oak^oar^oat^odd^ode^off^oft^ohm^oil^old^"
sChar3 = sChar3 & "^ole^one^opt^orb^ore^our^out^ova^owe^owl^own^pac^pad^pal^pan^pap^par^pat^paw^pax^pay^pea^pee^peg^pen^pep^per^pet^pew^pic^pie^pig^pin^pip^pit^pix^ply^pod^pog^poi^poo^pop^pot^pow^pox^pro^"
sChar3 = sChar3 & "^pry^pub^pud^pug^pun^pup^pus^put^pyx^qat^qua^quo^rad^rag^ram^ran^rap^rat^raw^ray^red^rib^rid^rig^rim^rip^rob^roc^rod^roe^rot^row^rub^rue^rug^rum^run^rut^rye^sac^sad^sag^sap^sat^saw^sax^"
sChar3 = sChar3 & "^say^sea^sec^see^set^sew^sex^she^shy^sic^sim^sin^sip^sir^sis^sit^six^ski^sky^sly^sob^sod^som^son^sop^sot^sow^soy^spa^spy^sty^sub^sue^sum^sun^sup^tab^tad^tag^tam^tan^tap^tar^tax^tea^tee^"
sChar3 = sChar3 & "^ten^the^tic^tie^til^tin^tip^tit^toe^tom^ton^too^top^tot^tow^toy^try^tub^tug^tui^tut^two^ugh^uke^ump^urn^use^van^vat^vee^vet^vex^via^vie^vig^vim^voe^vow^wad^wag^wan^war^was^wax^way^web^"
sChar3 = sChar3 & "^wed^wee^wen^wet^who^why^wig^win^wit^wiz^woe^wog^wok^won^woo^wow^wry^wye^yak^yam^yap^yaw^yay^yea^yen^yep^yes^yet^yew^yip^you^yow^yum^yup^zag^zap^zed^zee^zen^zig^zip^zit^zoa^zoo^"
'============================================================================================
'4)============================================================================================
'If the string matches a word that is ALWAYS changed to LCase...
If InStr(1, sLowerConcat, "^" & sWord & "^", vbTextCompare) > 0 Then GoTo gForceLower
'5)============================================================================================
'If the string matches a word that is ALWAYS changed to Proper Case...
If InStr(1, sProperConcat, "^" & sWord & "^", vbTextCompare) > 0 Then GoTo gForceProper
'============================================================================================
'============================================================================================
'Handle Word Length (1-3) or (4+)
If iWordLen > 3 Then GoTo gCharLenIsFourOrMore
If iWordLen = 3 Then GoTo gCharLenIsThree
If iWordLen = 2 Then GoTo gCharLenIsTwo
If iWordLen = 1 Then GoTo gCharLenIsOne
If iWordLen = 0 Then GoTo gFinalDecision
'============================================================================================
'---------------------------------------------------------------------------------------------
Debug.Print "Pause - does a goto 'Finish' statement need to be inserted here? [" & myWord & "]"
'---------------------------------------------------------------------------------------------
'#############################################################################################
'#############################################################################################
'---------------------------------------------------------------------------------------------
gHandleDashes:
'Handle Strings with Dashes differently depending on if there is a NUMBER Present... or if the portion of the string is already ALL Ucase
'Use the dash to split into individual words - review and apply rules, then restore the dashes
sWord = Replace(sWord, "-", " ~ ", , , vbTextCompare) 'use tilde, not dash~!
aSplitMe = Split(sWord, " ~ ")
For iLoop = LBound(aSplitMe) To UBound(aSplitMe)
'Change to proper if the string is not UCASE already
If aSplitMe(iLoop) <> UCase(aSplitMe(iLoop)) Then sWord = Replace(sWord, aSplitMe(iLoop), StrConv(aSplitMe(iLoop), vbProperCase), , , vbTextCompare) If Len(aSplitMe(iLoop)) < 4 Then sWord = Replace(sWord, aSplitMe(iLoop), UCase(aSplitMe(iLoop)), , , vbTextCompare)
'Change to UCASE if there is a number in the string
If aSplitMe(iLoop) Like "*#*" Then sWord = Replace(sWord, aSplitMe(iLoop), UCase(aSplitMe(iLoop)), , , vbTextCompare)
Next iLoop
Erase aSplitMe
sWord = Replace(sWord, " ~ ", "-", , , vbTextCompare)
GoTo gFinalDecision
'---------------------------------------------------------------------------------------------
'3-Action)RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
'Word is Roman Numerals - convert to UPPER - no further review
gRomanNumerals:
GoTo gForceUpper
'RRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRR
'4-6: Action)123123123123123123123123123123123123123123123123123123123123123123123123123123123123123123123
'If the String matches a valid word, Change to [Proper]. Otherwise, change it to [UPPER]
gCharLenIsThree:
If InStr(1, sChar3, sWord, vbTextCompare) > 0 Then GoTo gForceProper
GoTo gForceUpper
gCharLenIsTwo:
If InStr(1, sChar2, sWord, vbTextCompare) > 0 Then GoTo gForceProper
GoTo gForceUpper
gCharLenIsOne:
If InStr(1, sChar2, sWord, vbTextCompare) > 0 Then GoTo gForceProper
GoTo gForceUpper
gCharLenIsFourOrMore:
'IF it gets to this point, ALL decisions to handle exceptions have been made - the only choice is [Proper]
GoTo gForceProper
'123123123123123123123123123123123123123123123123123123123123123123123123123123123123123123123
'Convert) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Convert string to [lower]
gForceLower:
sWord = LCase(sWord)
GoTo gFinalDecision
'Convert string to [Proper]
gForceProper:
'Exception-------------------------------------------
'If the word is already all UCASE, leave it alone...
If sWord = UCase(sWord) And Len(sWord) > 3 Then GoTo gForceUpper
'Exception-------------------------------------------
sWord = StrConv(sWord, vbProperCase)
GoTo gFinalDecision
'Convert string to UPPER
gForceUpper:
sWord = UCase(sWord)
GoTo gFinalDecision
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
gFinalDecision:
ChooseCapitals = sWord
Exit Function
'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
gFoundAnError:
Debug.Print "Error occured when attempting to Choose Capitalization. Create Breakpoint and test for word [" & myWord & "]"
End Function
Supporting Functions 1-4: (Remember Delimiters, Split, Restore)
Function Cap1_LoadDelLocAndValString(myInputString As Variant, myDelimiterString As Variant) As String
Dim iLoop As Long, sMyString As String, sMyDelimiterString As String, myConcat As String
'---------------------------------------------------------------------------------------------------------------------------------------
'Create a snapshot of Delimiter values + Locations
'---------------------------------------------------------------------------------------------------------------------------------------
'myDelimiterString usually = " |,:^" - this method will create a string used to preserve Delimiters and their location in the string.
' Use: [Cap4_RestoreDelimiters] to restore the string to its original condition
'Note: Used [~] & [+] instead of [^] or [|] for Steps 1 & 4 because the Split was contaminated since those both are typical delimiters:
'Split Pattern = "[~][value1][+][value2][~]
'---------------------------------------------------------------------------------------------------------------------------------------
sMyString = myInputString
sMyDelimiterString = myDelimiterString
For iLoop = 1 To Len(sMyString)
If Mid(sMyString, iLoop, 1) Like "*[" & sMyDelimiterString & "*]" Then
myConcat = myConcat & "~" & Mid(sMyString, iLoop, 1) & "+" & iLoop & "~"
End If
Next iLoop
Cap1_LoadDelLocAndValString = myConcat
End Function
Function Cap2_ReplaceDelimiters(myInputString As Variant, myDelimiterString As Variant) As String
Dim iLoop As Long, sMyString As String, sMyDelimiterString As String
'---------------------------------------------------------------------------------------------------------------------------------------
'Change All Delimiters to: [^]
'---------------------------------------------------------------------------------------------------------------------------------------
'myDelimiterString usually = " |,:^" - Step 2: Hard coding the replacement value as [^] instead of allowing user input (See notes on Steps 1 & 4)
' Note: Step 2 uses hard coded [^] but Step 3 allows variable input - !!! Ensure they match or it will cause errors !!!
'---------------------------------------------------------------------------------------------------------------------------------------
sMyString = myInputString
sMyDelimiterString = myDelimiterString
For iLoop = 1 To Len(sMyDelimiterString)
sMyString = Replace(sMyString, Mid(sMyDelimiterString, iLoop, 1), "^", , , vbTextCompare)
Next iLoop
Cap2_ReplaceDelimiters = sMyString
End Function
Function Cap3_SplitAndReview(myInputString As Variant, myInputDelimiter) As String
Dim sWord As String, sDelimiter As String, sTempWord As String, iIndex As Long, iLoop As Long
Dim aSplitMe As Variant
'---------------------------------------------------------------------------------------------------------------------------------------
'Review each individual word using 1 global delimiter [^] for separation (Multiple Delimiters causes data to be over-written depending on order of operations)
'---------------------------------------------------------------------------------------------------------------------------------------
'sDelimiter usually = "^" - Step 2: Hard coding the replacement value as [^] instead of allowing user input (See notes on Steps 1 & 4)
' Note: Step 2 uses hard coded [^] but Step 3 allows variable input - !!! Ensure they match or it will cause errors !!!
'---------------------------------------------------------------------------------------------------------------------------------------
sWord = myInputString
sDelimiter = myInputDelimiter
aSplitMe = Split(sWord, sDelimiter)
For iLoop = LBound(aSplitMe) To UBound(aSplitMe)
sTempWord = sTempWord & ChooseCapitals(aSplitMe(iLoop)) & sDelimiter
Next iLoop
'Handle if the delimiter is at the end of the word:
If Right(sTempWord, Len(myInputDelimiter)) = myInputDelimiter Then
sTempWord = Left(sTempWord, Len(sTempWord) - Len(myInputDelimiter))
End If
Cap3_SplitAndReview = sTempWord
End Function
Function Cap4_RestoreDelimiters(myInputString As Variant, myDelimiterValues As Variant) As String
Dim iLoop As Long, sMyString As String, sMyDelimiterValues As String, myConcat As String
Dim sSplitMePipe As Variant, aSplitMeKaret As Variant
'---------------------------------------------------------------------------------------------------------------------------------------
'Restore the original delimiters
'---------------------------------------------------------------------------------------------------------------------------------------
'sMyDelimiterValues usually = " |,:^" - this method uses a snapshot of the original Delimiters and their location in the string so they can be restored after applying Capitalization rules.
' See: [Cap1_LoadDelLocAndValString] for creating the snapshot of the original string
'Note: Used [~] & [+] instead of [^] or [|] for Steps 1 & 4 because the Split was contaminated since those both are typical delimiters:
'Split Pattern = "[~][value1][+][value2][~]
'---------------------------------------------------------------------------------------------------------------------------------------
sMyString = myInputString
sMyDelimiterValues = myDelimiterValues
sSplitMePipe = Split(sMyDelimiterValues, "~")
For iLoop = LBound(sSplitMePipe) To UBound(sSplitMePipe)
If Len(sSplitMePipe(iLoop)) = 0 Then GoTo gNoValueSkipLoop
aSplitMeKaret = Split(sSplitMePipe(iLoop), "+")
sMyString = WorksheetFunction.Replace(sMyString, aSplitMeKaret(1), 1, aSplitMeKaret(0))
gNoValueSkipLoop:
Next iLoop
Cap4_RestoreDelimiters = sMyString
End Function
Dim iLoop As Long, sMyString As String, sMyDelimiterString As String, myConcat As String
'---------------------------------------------------------------------------------------------------------------------------------------
'Create a snapshot of Delimiter values + Locations
'---------------------------------------------------------------------------------------------------------------------------------------
'myDelimiterString usually = " |,:^" - this method will create a string used to preserve Delimiters and their location in the string.
' Use: [Cap4_RestoreDelimiters] to restore the string to its original condition
'Note: Used [~] & [+] instead of [^] or [|] for Steps 1 & 4 because the Split was contaminated since those both are typical delimiters:
'Split Pattern = "[~][value1][+][value2][~]
'---------------------------------------------------------------------------------------------------------------------------------------
sMyString = myInputString
sMyDelimiterString = myDelimiterString
For iLoop = 1 To Len(sMyString)
If Mid(sMyString, iLoop, 1) Like "*[" & sMyDelimiterString & "*]" Then
myConcat = myConcat & "~" & Mid(sMyString, iLoop, 1) & "+" & iLoop & "~"
End If
Next iLoop
Cap1_LoadDelLocAndValString = myConcat
End Function
Function Cap2_ReplaceDelimiters(myInputString As Variant, myDelimiterString As Variant) As String
Dim iLoop As Long, sMyString As String, sMyDelimiterString As String
'---------------------------------------------------------------------------------------------------------------------------------------
'Change All Delimiters to: [^]
'---------------------------------------------------------------------------------------------------------------------------------------
'myDelimiterString usually = " |,:^" - Step 2: Hard coding the replacement value as [^] instead of allowing user input (See notes on Steps 1 & 4)
' Note: Step 2 uses hard coded [^] but Step 3 allows variable input - !!! Ensure they match or it will cause errors !!!
'---------------------------------------------------------------------------------------------------------------------------------------
sMyString = myInputString
sMyDelimiterString = myDelimiterString
For iLoop = 1 To Len(sMyDelimiterString)
sMyString = Replace(sMyString, Mid(sMyDelimiterString, iLoop, 1), "^", , , vbTextCompare)
Next iLoop
Cap2_ReplaceDelimiters = sMyString
End Function
Function Cap3_SplitAndReview(myInputString As Variant, myInputDelimiter) As String
Dim sWord As String, sDelimiter As String, sTempWord As String, iIndex As Long, iLoop As Long
Dim aSplitMe As Variant
'---------------------------------------------------------------------------------------------------------------------------------------
'Review each individual word using 1 global delimiter [^] for separation (Multiple Delimiters causes data to be over-written depending on order of operations)
'---------------------------------------------------------------------------------------------------------------------------------------
'sDelimiter usually = "^" - Step 2: Hard coding the replacement value as [^] instead of allowing user input (See notes on Steps 1 & 4)
' Note: Step 2 uses hard coded [^] but Step 3 allows variable input - !!! Ensure they match or it will cause errors !!!
'---------------------------------------------------------------------------------------------------------------------------------------
sWord = myInputString
sDelimiter = myInputDelimiter
aSplitMe = Split(sWord, sDelimiter)
For iLoop = LBound(aSplitMe) To UBound(aSplitMe)
sTempWord = sTempWord & ChooseCapitals(aSplitMe(iLoop)) & sDelimiter
Next iLoop
'Handle if the delimiter is at the end of the word:
If Right(sTempWord, Len(myInputDelimiter)) = myInputDelimiter Then
sTempWord = Left(sTempWord, Len(sTempWord) - Len(myInputDelimiter))
End If
Cap3_SplitAndReview = sTempWord
End Function
Function Cap4_RestoreDelimiters(myInputString As Variant, myDelimiterValues As Variant) As String
Dim iLoop As Long, sMyString As String, sMyDelimiterValues As String, myConcat As String
Dim sSplitMePipe As Variant, aSplitMeKaret As Variant
'---------------------------------------------------------------------------------------------------------------------------------------
'Restore the original delimiters
'---------------------------------------------------------------------------------------------------------------------------------------
'sMyDelimiterValues usually = " |,:^" - this method uses a snapshot of the original Delimiters and their location in the string so they can be restored after applying Capitalization rules.
' See: [Cap1_LoadDelLocAndValString] for creating the snapshot of the original string
'Note: Used [~] & [+] instead of [^] or [|] for Steps 1 & 4 because the Split was contaminated since those both are typical delimiters:
'Split Pattern = "[~][value1][+][value2][~]
'---------------------------------------------------------------------------------------------------------------------------------------
sMyString = myInputString
sMyDelimiterValues = myDelimiterValues
sSplitMePipe = Split(sMyDelimiterValues, "~")
For iLoop = LBound(sSplitMePipe) To UBound(sSplitMePipe)
If Len(sSplitMePipe(iLoop)) = 0 Then GoTo gNoValueSkipLoop
aSplitMeKaret = Split(sSplitMePipe(iLoop), "+")
sMyString = WorksheetFunction.Replace(sMyString, aSplitMeKaret(1), 1, aSplitMeKaret(0))
gNoValueSkipLoop:
Next iLoop
Cap4_RestoreDelimiters = sMyString
End Function