proper case end of string

S

Serafin54

Board Regular
Joined
Apr 11, 2014
Messages
165
Office Version
  1. 2016
Platform
  1. Windows
I have recorded a macro to capitalize items that the Proper function doesn't catch. However, with some addresses directions can end a string such as "1st Elm Street NE". My code can catch it if the NE occurs during the anywhere within the string if a space is before and after it but can't if at the beginning or end. If i take out the space it would change items such as Nebraska to NEbraska so that doesn't work either. Is there a value that can be added to say if nothing before or after the value? Below is the code. I apologize for the sheer ugliness of it ahead of time. I'm sure it's rather bloated.

Thanks for looking.

VBA Code: 
Sub FORMATTING_Proper_Case(control As IRibbonControl)
    For Each Rng In Selection
    Rng.Value = Application.WorksheetFunction.Proper(Rng.Value)
    Next Rng
        Selection.Replace What:=" Nw ", Replacement:=" NW ", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:=" Sw ", Replacement:=" SW ", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:=" Ne ", Replacement:=" NE ", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:=" Se ", Replacement:=" SE ", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="1St", Replacement:="1st", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="2Nd", Replacement:="2nd", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="3Rd", Replacement:="3rd", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="4Th", Replacement:="4th", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="5Th", Replacement:="5th", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="6Th", Replacement:="6th", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="7Th", Replacement:="7th", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="8Th", Replacement:="8th", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="9Th", Replacement:="9th", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="0Th", Replacement:="0th", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="1Th", Replacement:="1th", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="2Th", Replacement:="2th", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="3Th", Replacement:="3th", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:=" ii", Replacement:=" II", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:=" iii", Replacement:=" III", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:=" iv ", Replacement:=" IV ", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:=" iv,", Replacement:=" IV,", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
End Sub
 
Sort by date Sort by votes
Peter_SSs said:
That sample file is a *.xlsx file and has no vba in it.
Was the code actually in the file when you ran it or in another workbook?
What cell(s)/range(s) did you have selected when you ran the code that hung and which 'Correct Case' code did you run (post #5 or #9 or a modification of one of those)?
Click to expand...

Unfortunately, when i am going to attach the file, due to IT constraints, it will not let me attach the file. I am selecting the entire column and running #9 Sub Correct_Case_v2()
 
Upvote 0
Using your sample file, with column A selected and running the code from post #9, the result is pretty much instantaneous.
Do you have other vba code in your version of that sample file as well as the code from post #9?
If so, what happens if you make another copy of the file and delete all other code except the post #9 code?
 
Upvote 0
I had to get creative to get around linking the shared file but here is a link to it. It is an xlsm and the code is present . Proper Case test file

I updated part of the Upper Case code to include a comma after suffixes as I noticed those weren't getting addressed. For example, Smith III, John would convert as Smith Iii, John. This is a completely different file but with same results.
 
Upvote 0
Serafin54 said:
I had to get creative to get around linking the shared file but here is a link to it.
Click to expand...
Thanks for the sample file. That has shown up a number of things.

A.
Serafin54 said:
I am selecting the entire column and running #9 Sub Correct_Case_v2()
Click to expand...
According to that sample file you are not running the code from post #9. Your sample file includes extra code ..

Rich (BB code): 
Sub Proper_Case()
    For Each Rng In Selection
    Rng.Value = Application.WorksheetFunction.Proper(Rng.Value)
    Next Rng
 Dim RX As Object, M As Object

If you have column B selected then his red (extra) code is processing all one million+ cells in column B and turning them into proper case, including the million+ blank ones. Further it is doing that with ScreenUpdating turned on which slows the process further & considerably.

The original code from post #9 only acts on the column section that actually contains data (just 244 rows in the sample) and already initially converts the text into proper case so there was no need for the above red code anyway.
Rich (BB code): 
        For i = 1 To UBound(a)
          a(i, 1) = Application.WorksheetFunction.Proper(a(i, 1))
          RX.Pattern = Pat1

B.
Serafin54 said:
I updated part of the Upper Case code to include a comma after suffixes
Click to expand...
When you did that, you introduced a "|" at the end of the midle part of the pattern.
Rich (BB code): 
Const Pat1 As String = "(^| )(nw|ne|sw|se|ii|iii|iv|ii,|iii,|iv,|)(?= |$)"
The original pattern did not have that trailing "|" and it could lead to problem results.

Further, there is a better way to deal with the comma in that situation. Rather than re-list all the relevant options with a following comma, the comma can be moved into the final section of the pattern like this
Rich (BB code): 
Const Pat1 As String = "(^| )(nw|ne|sw|se|ii|iii|iv)(?=,| |$)"

C.
You have the code in the ThisWorkbook module. It would be better in a standard module.


Given all of the above, try this code in a standard module. Again, it is very fast with column B of the sample file selected.

VBA Code: 
Sub Proper_Case_v3()
  Dim RX As Object, M As Object
  Dim a As Variant
  Dim i As Long
  Dim col As Range
 
  Const Pat1 As String = "(^| )(nw|ne|sw|se|ii|iii|iv)(?=,| |$)"  'items (in middle parentheses) to be made UPPER case
  Const Pat2 As String = "(\d)(st|nd|rd|th)(?= |$)"               'items (in middle parentheses) to be made lower case
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  Application.ScreenUpdating = False
  For Each col In Selection.EntireColumn.Columns
    With col.Resize(Cells(Rows.Count, col.Column).End(xlUp).Row)
      If .Rows.Count > 1 Then
        a = .Value
        For i = 1 To UBound(a)
          a(i, 1) = Application.WorksheetFunction.Proper(a(i, 1))
          RX.Pattern = Pat1
          For Each M In RX.Execute(a(i, 1))
            Mid(a(i, 1), M.firstindex + 1, Len(M)) = UCase(M)
          Next M
          RX.Pattern = Pat2
          For Each M In RX.Execute(a(i, 1))
            Mid(a(i, 1), M.firstindex + 1, Len(M)) = LCase(M)
          Next M
        Next i
        .Value = a
      End If
    End With
  Next col
  Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Peter_SSs said:
Thanks for the sample file. That has shown up a number of things.

A.

According to that sample file you are not running the code from post #9. Your sample file includes extra code ..

Rich (BB code): 
Sub Proper_Case()
    For Each Rng In Selection
    Rng.Value = Application.WorksheetFunction.Proper(Rng.Value)
    Next Rng
 Dim RX As Object, M As Object

If you have column B selected then his red (extra) code is process all one million+ cells in column B and turning them into proper case, including the million+ blank ones. Further it is doing that with ScreenUpdating turned on which slows the process further & considerably.

The original code from post #9 only acts on the column section that actually contains data (just 244 rows in the sample) and already initially converts the text into proper case so there was no need for the above red code anyway.
Rich (BB code): 
        For i = 1 To UBound(a)
          a(i, 1) = Application.WorksheetFunction.Proper(a(i, 1))
          RX.Pattern = Pat1

B.

When you did that, you introduced a "|" at the end of the midle part of the pattern.
Rich (BB code): 
Const Pat1 As String = "(^| )(nw|ne|sw|se|ii|iii|iv|ii,|iii,|iv,|)(?= |$)"
The original pattern did not have that trailing "|" and it could lead to problem results.

Further, there is a better way to deal with the comma in that situation. Rather than re-list all the relevant options with a following comma, the comma can be moved into the final section of the pattern like this
Rich (BB code): 
Const Pat1 As String = "(^| )(nw|ne|sw|se|ii|iii|iv)(?=,| |$)"

C.
You have the code in the ThisWorkbook module. It would be better in a standard module.


Given all of the above, try this code in a standard module. Again, it is very fast with column B of the sample file selected.

VBA Code: 
Sub Proper_Case_v3()
  Dim RX As Object, M As Object
  Dim a As Variant
  Dim i As Long
  Dim col As Range
 
  Const Pat1 As String = "(^| )(nw|ne|sw|se|ii|iii|iv)(?=,| |$)"  'items (in middle parentheses) to be made UPPER case
  Const Pat2 As String = "(\d)(st|nd|rd|th)(?= |$)"               'items (in middle parentheses) to be made lower case
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  Application.ScreenUpdating = False
  For Each col In Selection.EntireColumn.Columns
    With col.Resize(Cells(Rows.Count, col.Column).End(xlUp).Row)
      If .Rows.Count > 1 Then
        a = .Value
        For i = 1 To UBound(a)
          a(i, 1) = Application.WorksheetFunction.Proper(a(i, 1))
          RX.Pattern = Pat1
          For Each M In RX.Execute(a(i, 1))
            Mid(a(i, 1), M.firstindex + 1, Len(M)) = UCase(M)
          Next M
          RX.Pattern = Pat2
          For Each M In RX.Execute(a(i, 1))
            Mid(a(i, 1), M.firstindex + 1, Len(M)) = LCase(M)
          Next M
        Next i
        .Value = a
      End If
    End With
  Next col
  Application.ScreenUpdating = True
End Sub
Click to expand...

Thank you! I am thoroughly confused at where that piece of code even came from. I am not advanced enough to even write something like that. I will need to ask my coworker if they updated something but yes this does seem much faster.

I do have these codes in a stand alone module for my custom ui tab. I only added it as such as copy/paste to get you the code but I don't normally just have it in the ThisWorkbook module.

With the part about re-listing the commas, how would i be able to add Parenthesis for instance? I assume that if i add ( or ) to that list, it will cause the code to fail?
 
Upvote 0
Serafin54 said:
I am thoroughly confused at where that piece of code even came from.
Click to expand...
Looks like it came from the original code you posted in post #1

1653436772605.png




Serafin54 said:
With the part about re-listing the commas, how would i be able to add Parenthesis for instance? I assume that if i add ( or ) to that list, it will cause the code to fail?
Click to expand...
Parentheses can be tricky as they have special meaning in regular expression syntax. However, there is a good chance they can be handled successfully.

Could you provide 3 or 4 examples of original text that include parentheses and give the final expected outcome from that text?
Make sure that your samples show any variety there might be about where any parentheses might occur and any differences in their treatment.
 
Upvote 0
Peter_SSs said:
Looks like it came from the original code you posted in post #1

View attachment 65473




Parentheses can be tricky as they have special meaning in regular expression syntax. However, there is a good chance they can be handled successfully.

Could you provide 3 or 4 examples of original text that include parentheses and give the final expected outcome from that text?
Make sure that your samples show any variety there might be about where any parentheses might occur and any differences in their treatment.
Click to expand...

I think we are ok at this point Peter. The times that they may poke their ugly head is few and far between and can be handled with a find/replace. I was just asking out of curiosity how they would be handled but it appears there may be far more variations than i expected.

I really appreciate your time and don't want to take more of it as I already feel bad as it is.

Thank you immensely!
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Question Question
US/European Date Format Updates Not Working on Macro Run
Replies
0
Views
193
vancher19
V
L
  • Question Question
How to loop to find and replace with the specific cells
Replies
2
Views
423
Linda Lo
L
J
  • Solved
Assistance with excel macro
Replies
3
Views
294
dreid1011
dreid1011
N
  • Question Question
Not understanding loop in vba
Replies
7
Views
362
jolivanes
jolivanes
L
  • Locked
  • Question Question
Macros and protecting a cell
Replies
5
Views
187
Fluff
Fluff

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top