Proper case module help!

  • Thread starter Thread starter riccifs
  • Start date Start date
R

riccifs

Hi to everyone,
to check the proper case of my data string I'm using the module I
found at this web-site: http://www.rogersaccesslibrary.com/Otherdownload.asp?SampleName='Proper Case Function'
It's working very well but I'd like to add in it the possibility to
control name like this: "AA.BB.CC. Industry"
The module already can work with string like this "A.B.C. Industries"
but if I write two or three characters between the dots it doesn't
capitalize all.
As you can see, the result will be "Aa.Bb.Cc. Industry" and not
"AA.BB.CC. Industry" as I would aspect.

Hope someone will give to me an hand
Bye,
Stefano.

I'll post the module code below:

***start code***
Option Compare Database
Option Explicit
Function fProperCase(Optional strText As String, Optional blPrompt As
Boolean) As String
'Call this function in this manner:
' ProperCase("yourTexthere")
' If you would like to automatically capitalize all 2 or 3 character
words, then call in this manner:
' ProperCase(yourTexthere,1)
' Please note any two or three character words in the string will
automatically capitalize if all
' of the characters in the string are the same, regardles of the value
of this parameter (AAA Insurance Company)

'If any improvements/clean up/errors found in this code, please
'email David McAfee at (e-mail address removed)
Dim intCounter As Integer
Dim OneChar As String
Dim StartingNumber As Integer
StartingNumber = 1

If Nz(strText, "") <> "" Then 'If value is not blank, then continue
below
'******************** Start - Check for 3 character words at the
start of string
If Right(Left(strText, 4), 1) = " " Then
If (Left(strText, 1) = Mid$(strText, 2, 1) And Left(strText,
1) = Mid$(strText, 3, 1)) Or blPrompt = True Then
'Capitalize the 3 char's as in "AAA" or "EEE Movers"
strText = UCase(Left$(strText, 3)) & LCase$(Mid$(strText,
4, 255))
StartingNumber = 4
Else
'Only capitalize the first of the 3 char's
'This part can be removed if you do not want the 1st
letter capitalized
strText = UCase$(Left$(strText, 1)) & LCase$(Mid$(strText,
2, 255))
StartingNumber = 2
End If '******************** End - 3 letter check at beginning
of string

ElseIf Right(Left(strText, 3), 1) = " " Then 'Check for 2
character words as the start of the string
If Left(strText, 1) = Mid$(strText, 2, 1) Or blPrompt = True
Then
'Capitalize the 2 char's
strText = UCase(Left$(strText, 2)) & LCase$(Mid$(strText,
3, 255))
StartingNumber = 3
Else
'Only capitalize the first of the 2 char's
'This part can be removed if you do not want the 1st
letter capitalized
strText = UCase(Left$(strText, 1)) & LCase$(Mid$(strText,
2, 255))
StartingNumber = 2
End If '***************** End 2 character word Check
Else
'The first word is not 2 or 3 char in length, so convert first
character to capital then the rest to lowercase.
strText = UCase$(Left$(strText, 1)) & LCase$(Mid$(strText, 2,
255))
StartingNumber = 2
End If


'Look at each character, starting at the second character.
For intCounter = StartingNumber To Len(strText)
OneChar = Mid$(strText, intCounter, 1)
Select Case OneChar
'...convert the character after dash/hyphen/slash/period/
ampersand to uppercase such as "A.B.C. Industries", B&B Mfg
Case "-", "/", ".", "&", "+"
strText = Left$(strText, intCounter) & UCase$(Mid$
(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
Case "'" 'Check the character two places after the apostrophe.
If Mid$(strText, intCounter + 2, 1) <> " " Then 'If it is
not a space, then capatilize (O'Conner, O'Niel)
strText = Left$(strText, intCounter) & UCase$(Mid$
(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
Else
'Do nothing as in "Don't" , "Tom's Diner", "haven't",
"I'm"
End If
Case "c" ' Take care of the McAfee's, McDonalds & McLaughlins
and such
If (Mid$(strText, intCounter - 1, 2) = "Mc") Then 'Check
if Prev Char is an M
If ((intCounter - 2) < 1) Then 'Check to see if the M
was the first character
strText = "Mc" & UCase$(Mid$(strText, intCounter +
1, 1)) & Mid$(strText, intCounter + 2, 255)
ElseIf (Mid$(strText, intCounter - 2, 1) = " ") Then
'If M wasn't first character, then check to see if
a space was before the M, so we don't capitalize Tomchek or Adamczyk
strText = Left$(strText, intCounter) & UCase$(Mid$
(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
End If
End If
Case " "
Select Case Mid$(strText, intCounter + 1, 3)
Case "de " 'Add any other exceptions here Example:
Oscar de La Hoya or maria de jesus
strText = Left$(strText, intCounter) & "de " & Mid$
(strText, intCounter + 4, 255)
intCounter = intCounter + 2
Case Else ' Example: A B C Manufacturing
strText = Left$(strText, intCounter) & UCase$(Mid$
(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
End Select
If Mid$(strText, intCounter + 1, 9) = "diMartini" Then
'Add any other odd balls in this fashion
strText = Left$(strText, intCounter) & "diMartini" &
Mid$(strText, intCounter + 10, 255)
End If
'Method for adding new case is fairly simple, such in the
example above: "de "
'If Mid$(strText, intCounter + 1,
Len("YourExclusionHere")) = "YourExclusionHere" Then
' strText = Left$(strText, intCounter) &
"YourExclusionHere" & Mid$(strText, intCounter +
(LEN("YourExclusionHere")+1), 255)
'End If
'*********************** Check for 3 character word
*******************
If Mid$(strText, intCounter + 4, 1) = " " Or (Len(strText)
- intCounter = 3) Then
If (Mid$(strText, intCounter + 1, 1) = Mid$(strText,
intCounter + 2, 1) And _
Mid$(strText, intCounter + 1, 1) = Mid$(strText,
intCounter + 3, 1)) Or blPrompt = True Then
'Capitalize the 3 char's as in "AAA" or "EEE
Movers"
strText = Left$(strText, intCounter) & UCase(Mid$
(strText, intCounter + 1, 3)) & Mid$(strText, intCounter + 4, 255)
intCounter = intCounter + 3
Else
'Only capitalize the first of the 3 char's
'This part can be removed if you do not want the
1st letter capitalized
strText = Left$(strText, intCounter) & UCase$(Mid$
(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
End If
'********************** check for 2 char words
*******************
ElseIf Mid(strText, intCounter + 3, 1) = " " Or
(Len(strText) - intCounter = 2) Then
If (Mid(strText, intCounter + 1, 1) = Mid(strText,
intCounter + 2, 1)) Or blPrompt = True Then
'Capitalize the 2 char's
'This part can be omitted if you do not want to
automatically capitalize a 2 character word made up of two identical
letters
strText = Left$(strText, intCounter) & UCase(Mid$
(strText, intCounter + 1, 2)) & LCase$(Mid$(strText, intCounter + 3,
255))
intCounter = intCounter + 2
Else
'Only capitalize the first of the 2 char's
strText = Left$(strText, intCounter) & UCase(Mid$
(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
intCounter = intCounter + 1
End If
'******************** END 2 LETTER CHECK
End If
Case Else
End Select
Next
Else
strText = ""
End If
'All done, return current contents of strText variable.
fProperCase = strText

End Function
***end code***
 
Hi to everyone,
to check the proper case of my data string I'm using the module I
found at this web-site:
http://www.rogersaccesslibrary.com/Otherdownload.asp?SampleName='Proper Case Function'
It's working very well but I'd like to add in it the possibility to
control name like this: "AA.BB.CC. Industry"
The module already can work with string like this "A.B.C. Industries"
but if I write two or three characters between the dots it doesn't
capitalize all.
As you can see, the result will be "Aa.Bb.Cc. Industry" and not
"AA.BB.CC. Industry" as I would aspect.

Hope someone will give to me an hand
Bye,
Stefano.

I'll post the module code below:

***start code***
Option Compare Database
Option Explicit
Function fProperCase(Optional strText As String, Optional blPrompt As
Boolean) As String
'Call this function in this manner:
' ProperCase("yourTexthere")
' If you would like to automatically capitalize all 2 or 3 character
words, then call in this manner:
' ProperCase(yourTexthere,1)
' Please note any two or three character words in the string will
automatically capitalize if all
' of the characters in the string are the same, regardles of the value
of this parameter (AAA Insurance Company)

'If any improvements/clean up/errors found in this code, please
'email David McAfee at (e-mail address removed)
Dim intCounter As Integer
Dim OneChar As String
Dim StartingNumber As Integer
StartingNumber = 1

If Nz(strText, "") <> "" Then 'If value is not blank, then continue
below
'******************** Start - Check for 3 character words at the
start of string
If Right(Left(strText, 4), 1) = " " Then
If (Left(strText, 1) = Mid$(strText, 2, 1) And Left(strText,
1) = Mid$(strText, 3, 1)) Or blPrompt = True Then
'Capitalize the 3 char's as in "AAA" or "EEE Movers"
strText = UCase(Left$(strText, 3)) & LCase$(Mid$(strText,
4, 255))
StartingNumber = 4
Else
'Only capitalize the first of the 3 char's
'This part can be removed if you do not want the 1st
letter capitalized
strText = UCase$(Left$(strText, 1)) & LCase$(Mid$(strText,
2, 255))
StartingNumber = 2
End If '******************** End - 3 letter check at beginning
of string

ElseIf Right(Left(strText, 3), 1) = " " Then 'Check for 2
character words as the start of the string
If Left(strText, 1) = Mid$(strText, 2, 1) Or blPrompt = True
Then
'Capitalize the 2 char's
strText = UCase(Left$(strText, 2)) & LCase$(Mid$(strText,
3, 255))
StartingNumber = 3
Else
'Only capitalize the first of the 2 char's
'This part can be removed if you do not want the 1st
letter capitalized
strText = UCase(Left$(strText, 1)) & LCase$(Mid$(strText,
2, 255))
StartingNumber = 2
End If '***************** End 2 character word Check
Else
'The first word is not 2 or 3 char in length, so convert first
character to capital then the rest to lowercase.
strText = UCase$(Left$(strText, 1)) & LCase$(Mid$(strText, 2,
255))
StartingNumber = 2
End If


'Look at each character, starting at the second character.
For intCounter = StartingNumber To Len(strText)
OneChar = Mid$(strText, intCounter, 1)
Select Case OneChar
'...convert the character after dash/hyphen/slash/period/
ampersand to uppercase such as "A.B.C. Industries", B&B Mfg
Case "-", "/", ".", "&", "+"
strText = Left$(strText, intCounter) & UCase$(Mid$
(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
Case "'" 'Check the character two places after the apostrophe.
If Mid$(strText, intCounter + 2, 1) <> " " Then 'If it is
not a space, then capatilize (O'Conner, O'Niel)
strText = Left$(strText, intCounter) & UCase$(Mid$
(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
Else
'Do nothing as in "Don't" , "Tom's Diner", "haven't",
"I'm"
End If
Case "c" ' Take care of the McAfee's, McDonalds & McLaughlins
and such
If (Mid$(strText, intCounter - 1, 2) = "Mc") Then 'Check
if Prev Char is an M
If ((intCounter - 2) < 1) Then 'Check to see if the M
was the first character
strText = "Mc" & UCase$(Mid$(strText, intCounter +
1, 1)) & Mid$(strText, intCounter + 2, 255)
ElseIf (Mid$(strText, intCounter - 2, 1) = " ") Then
'If M wasn't first character, then check to see if
a space was before the M, so we don't capitalize Tomchek or Adamczyk
strText = Left$(strText, intCounter) & UCase$(Mid$
(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
End If
End If
Case " "
Select Case Mid$(strText, intCounter + 1, 3)
Case "de " 'Add any other exceptions here Example:
Oscar de La Hoya or maria de jesus
strText = Left$(strText, intCounter) & "de " & Mid$
(strText, intCounter + 4, 255)
intCounter = intCounter + 2
Case Else ' Example: A B C Manufacturing
strText = Left$(strText, intCounter) & UCase$(Mid$
(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
End Select
If Mid$(strText, intCounter + 1, 9) = "diMartini" Then
'Add any other odd balls in this fashion
strText = Left$(strText, intCounter) & "diMartini" &
Mid$(strText, intCounter + 10, 255)
End If
'Method for adding new case is fairly simple, such in the
example above: "de "
'If Mid$(strText, intCounter + 1,
Len("YourExclusionHere")) = "YourExclusionHere" Then
' strText = Left$(strText, intCounter) &
"YourExclusionHere" & Mid$(strText, intCounter +
(LEN("YourExclusionHere")+1), 255)
'End If
'*********************** Check for 3 character word
*******************
If Mid$(strText, intCounter + 4, 1) = " " Or (Len(strText)
- intCounter = 3) Then
If (Mid$(strText, intCounter + 1, 1) = Mid$(strText,
intCounter + 2, 1) And _
Mid$(strText, intCounter + 1, 1) = Mid$(strText,
intCounter + 3, 1)) Or blPrompt = True Then
'Capitalize the 3 char's as in "AAA" or "EEE
Movers"
strText = Left$(strText, intCounter) & UCase(Mid$
(strText, intCounter + 1, 3)) & Mid$(strText, intCounter + 4, 255)
intCounter = intCounter + 3
Else
'Only capitalize the first of the 3 char's
'This part can be removed if you do not want the
1st letter capitalized
strText = Left$(strText, intCounter) & UCase$(Mid$
(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
End If
'********************** check for 2 char words
*******************
ElseIf Mid(strText, intCounter + 3, 1) = " " Or
(Len(strText) - intCounter = 2) Then
If (Mid(strText, intCounter + 1, 1) = Mid(strText,
intCounter + 2, 1)) Or blPrompt = True Then
'Capitalize the 2 char's
'This part can be omitted if you do not want to
automatically capitalize a 2 character word made up of two identical
letters
strText = Left$(strText, intCounter) & UCase(Mid$
(strText, intCounter + 1, 2)) & LCase$(Mid$(strText, intCounter + 3,
255))
intCounter = intCounter + 2
Else
'Only capitalize the first of the 2 char's
strText = Left$(strText, intCounter) & UCase(Mid$
(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
intCounter = intCounter + 1
End If
'******************** END 2 LETTER CHECK
End If
Case Else
End Select
Next
Else
strText = ""
End If
'All done, return current contents of strText variable.
fProperCase = strText

End Function
***end code***
Click to expand...

Looks like your capitalized characters always end with a period(".").
If so then try this. Paste this function into a standard module:

Public Function MyProperCase(ByVal Buffer As String) As String
Dim p As Long

p = InStrRev(Buffer, ".")
MyProperCase = Left(Buffer, p) & StrConv(Mid$(Buffer, p + 1),
vbProperCase)
End Function

Then use it like this:

Debug.Print MyProperCase("AA.BB.CC. induSTry")

Result:

AA.BB.CC. Industry
 
Looks like your capitalized characters always end with a period(".").
If so then try this. Paste this function into a standard module:

Public Function MyProperCase(ByVal Buffer As String) As String
Dim p As Long

p = InStrRev(Buffer, ".")
MyProperCase = Left(Buffer, p) & StrConv(Mid$(Buffer, p + 1),
vbProperCase)
End Function

Then use it like this:

Debug.Print MyProperCase("AA.BB.CC. induSTry")

Result:

AA.BB.CC. Industry
Click to expand...

Hi Stuart,
that is fine but what I really would like to do is to integrate your
function in the main one.
Looking inside the module, this part is the one that make change
a.b.c. in A.B.C.

'...convert the character after dash/hyphen/slash/period/ampersand to
uppercase such as "A.B.C. Industries", B&B Mfg
Case "-", "/", ".", "&", "+"
strText = Left$(strText, intCounter) & UCase$(Mid$(strText, intCounter
+ 1, 1)) & Mid$(strText, intCounter + 2, 255)

Is it possible for you to rewrite only this part of the code to make
change aa.bb.cc. to AA.BB.CC. and not only a.b.c. to A.B.C.?
Hope to haer your answer...
Bye,
Stefano.
 
Hi Stuart,
that is fine but what I really would like to do is to integrate your
function in the main one.
Looking inside the module, this part is the one that make change
a.b.c. in A.B.C.

'...convert the character after dash/hyphen/slash/period/ampersand to
uppercase such as "A.B.C. Industries", B&B Mfg
Case "-", "/", ".", "&", "+"
strText = Left$(strText, intCounter) & UCase$(Mid$(strText, intCounter
+ 1, 1)) & Mid$(strText, intCounter + 2, 255)

Is it possible for you to rewrite only this part of the code to make
change aa.bb.cc. to AA.BB.CC. and not only a.b.c. to A.B.C.?
Hope to haer your answer...
Bye,
Stefano.
Click to expand...

Ok. I haven't the time nor inclination to paste that lot into a module,
clean up all the email junk and make sure all lines are properly unsplit, so
this is completely untested, but you could try extending this line:

ElseIf Right(Left(strText, 3), 1) = " " Then 'Check for 2 character words as
the start of the string

to read (without the comment) :

ElseIf Right(Left(strText, 3), 1) = " " Or Right(Left(strText, 3), 1) = "."
Then


Hope that helps you.
 
Ok. I haven't the time nor inclination to paste that lot into a module,
clean up all the email junk and make sure all lines are properly unsplit, so
this is completely untested, but you could try extending this line:

ElseIf Right(Left(strText, 3), 1) = " " Then 'Check for 2 character words as
the start of the string

to read (without the comment) :

ElseIf Right(Left(strText, 3), 1) = " " Or Right(Left(strText, 3), 1) = "."
Then

Hope that helps you.
Click to expand...

I think your idea is good but it seems doesn't work for me.
I pasted this piece
Or Right(Left(strText, 3), 1) = "." Then after the already there
ElseIf Right(Left(strText, 3), 1) = " "

but the final result is still that Aa.Bb.Cc.

Could explain to me how to do, please!
 
I think your idea is good but it seems doesn't work for me.
I pasted this piece
Or Right(Left(strText, 3), 1) = "." Then after the already there
ElseIf Right(Left(strText, 3), 1) = " "

but the final result is still that Aa.Bb.Cc.

Could explain to me how to do, please!
Click to expand...

This is my last try at this. After which I have no more ideas.

Scroll down to the part:

And change the code to read:

ElseIf Mid(strText, intCounter + 3, 1) = " " Or Mid(strText, intCounter + 3,
1) = "." Or (Len(strText) - intCounter = 2) Then
 
This is my last try at this. After which I have no more ideas.

Scroll down to the part:


And change the code to read:

ElseIf Mid(strText, intCounter + 3, 1) = " " Or Mid(strText, intCounter + 3,
1) = "." Or (Len(strText) - intCounter = 2) Then
Click to expand...

You did it!
NOW IT WORKS, I changed the last string you suggest to me plus this
part:
'...convert the character after dash/hyphen/slash/period/ampersand to
uppercase such as "A.B.C. Industries", B&B Mfg:
from this
strText = Left$(strText, intCounter) & UCase$(Mid$(strText, intCounter
+ 1, 1)) & Mid$(strText, intCounter + 2, 255)
to this
strText = Left$(strText, intCounter) & UCase$(Mid$(strText, intCounter
+ 1, 2)) & Mid$(strText, intCounter + 3, 255)

I'm more than a thank to you, I really appreciate your help... without
your last hints I could not solve the clue!
Bye,
Stefano.
 
Back
Top