Handle Capitalization for Roman Numerals
Function ConvertRomanNumerals(myString As Variant) As String
Dim sTemp As String, aSplitMe As Variant, iLoop As Long, sChunk As String, sReassemble As String, sReduce As String
'----------------------------------------------------------------------------------------------------------------------------
'Convert to String Type and change to Proper Case
sTemp = StrConv(myString, vbProperCase)
'----------------------------------------------------------------------------------------------------------------------------
'Check to see if the characters [i] or [v] exist in the string - skip the conversion process if they dont:
If InStr(1, sTemp, "i", vbTextCompare) > 0 Then GoTo gRomanNumeralCharFoundProcessString
If InStr(1, sTemp, "v", vbTextCompare) > 0 Then GoTo gRomanNumeralCharFoundProcessString
'If it hasn't skipped the process, go to the Review process
GoTo gFinishedProcessingSoReturnResults
'----------------------------------------------------------------------------------------------------------------------------
gRomanNumeralCharFoundProcessString:
'Create a splitter to handle each chunk of the string
aSplitMe = Split(sTemp, " ")
'Loop through each chunk of the string
For iLoop = LBound(aSplitMe) To UBound(aSplitMe)
sChunk = aSplitMe(iLoop)
If InStr(1, sChunk, "i", vbTextCompare) > 0 Then GoTo gProcessThisChunk
If InStr(1, sChunk, "v", vbTextCompare) > 0 Then GoTo gProcessThisChunk
GoTo SkipLoopNotReviewable
gProcessThisChunk:
If Len(sChunk) > 7 Then GoTo SkipLoopNotReviewable
'Remove the I's and V's, then check the length - only change to upper case if the string has been reduced to nothing.
sReduce = Replace(sChunk, "i", "", , , vbTextCompare)
sReduce = Replace(sReduce, "v", "", , , vbTextCompare)
If Len(sReduce) > 0 Then GoTo SkipLoopNotReviewable
'If it got this far, the only characters in the string are V's and I's and it needs to be changed to upper case!!!
sChunk = UCase(sChunk)
SkipLoopNotReviewable:
sReassemble = sReassemble & " " & sChunk
Next iLoop
GoTo gConvertedStringReturnDifferentTempString
'----------------------------------------------------------------------------------------------------------------------------
'Once it gets here, it returns the results
gFinishedProcessingSoReturnResults:
ConvertRomanNumerals = sTemp
GoTo gFixTheWordAnd
Exit Function
'----------------------------------------------------------------------------------------------------------------------------
gConvertedStringReturnDifferentTempString:
ConvertRomanNumerals = Trim(sReassemble)
GoTo gFixTheWordAnd
Exit Function
gFixTheWordAnd:
ConvertRomanNumerals = Replace(ConvertRomanNumerals, " and ", " and ", , , vbTextCompare)
End Function
Dim sTemp As String, aSplitMe As Variant, iLoop As Long, sChunk As String, sReassemble As String, sReduce As String
'----------------------------------------------------------------------------------------------------------------------------
'Convert to String Type and change to Proper Case
sTemp = StrConv(myString, vbProperCase)
'----------------------------------------------------------------------------------------------------------------------------
'Check to see if the characters [i] or [v] exist in the string - skip the conversion process if they dont:
If InStr(1, sTemp, "i", vbTextCompare) > 0 Then GoTo gRomanNumeralCharFoundProcessString
If InStr(1, sTemp, "v", vbTextCompare) > 0 Then GoTo gRomanNumeralCharFoundProcessString
'If it hasn't skipped the process, go to the Review process
GoTo gFinishedProcessingSoReturnResults
'----------------------------------------------------------------------------------------------------------------------------
gRomanNumeralCharFoundProcessString:
'Create a splitter to handle each chunk of the string
aSplitMe = Split(sTemp, " ")
'Loop through each chunk of the string
For iLoop = LBound(aSplitMe) To UBound(aSplitMe)
sChunk = aSplitMe(iLoop)
If InStr(1, sChunk, "i", vbTextCompare) > 0 Then GoTo gProcessThisChunk
If InStr(1, sChunk, "v", vbTextCompare) > 0 Then GoTo gProcessThisChunk
GoTo SkipLoopNotReviewable
gProcessThisChunk:
If Len(sChunk) > 7 Then GoTo SkipLoopNotReviewable
'Remove the I's and V's, then check the length - only change to upper case if the string has been reduced to nothing.
sReduce = Replace(sChunk, "i", "", , , vbTextCompare)
sReduce = Replace(sReduce, "v", "", , , vbTextCompare)
If Len(sReduce) > 0 Then GoTo SkipLoopNotReviewable
'If it got this far, the only characters in the string are V's and I's and it needs to be changed to upper case!!!
sChunk = UCase(sChunk)
SkipLoopNotReviewable:
sReassemble = sReassemble & " " & sChunk
Next iLoop
GoTo gConvertedStringReturnDifferentTempString
'----------------------------------------------------------------------------------------------------------------------------
'Once it gets here, it returns the results
gFinishedProcessingSoReturnResults:
ConvertRomanNumerals = sTemp
GoTo gFixTheWordAnd
Exit Function
'----------------------------------------------------------------------------------------------------------------------------
gConvertedStringReturnDifferentTempString:
ConvertRomanNumerals = Trim(sReassemble)
GoTo gFixTheWordAnd
Exit Function
gFixTheWordAnd:
ConvertRomanNumerals = Replace(ConvertRomanNumerals, " and ", " and ", , , vbTextCompare)
End Function