proper case end of string

S

Serafin54

Board Regular
Joined
Apr 11, 2014
Messages
160
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
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Sort by date Sort by votes
Is there a value that can be added to say if nothing before or after the value?
Click to expand...
Not sure what you're asking for. Plus, what is "nothing" - a space? Literally nothing?
Perhaps test using IF with Left function:
If Left(rng.Value,1) = " " Then <<finds 1 empty space
Can't tell what that code is doing because there's no hint of what is in each range. Are you converting ne to Ne with proper case function, then replacing Ne with NE?
 
Upvote 0
The code first activates the Proper function but then makes some exceptions such as directions, generational numerals and numeric values.

So for example, the address may be in all caps such as "123 4TH STREET NE". When i use this macro, it will put everything in proper case but unlike the proper function which would put "4Th", mine puts it as "4th". However my code also says replace " NE " with " NE " instead of how Proper would list it as " NE " except in this case because my code is specifically looking for a space before and after "NE" "SE" "SW" "NW" so that if used in a name column or state column words like "Sweet" and "Nebraska" wouldn't have the first two letters capitalized. What i am saying is that if the NE,SE,SW or NW occur as the end of the string in a cell, they should be in all caps and not proper case.
 
Upvote 0
Hard to give accurate suggestions based on limited examples, but given the sample, you could also just UCase(Right("stringHere",2)) so
UCase(Right("Ne",2)) = NE
 
Upvote 0
Not sure that I have all your requirements covered but perhaps try this alternative approach with another copy of your data (with appropriate range selected) to see if it could be headed in the right direction.

VBA Code: 
Sub Correct_Case()
  Dim RX As Object, M As Object
  Dim a As Variant
  Dim i As Long
  
  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
  a = Selection.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
  Selection.Value = a
End Sub
 
Upvote 0
Peter_SSs said:
Not sure that I have all your requirements covered but perhaps try this alternative approach with another copy of your data (with appropriate range selected) to see if it could be headed in the right direction.

VBA Code: 
Sub Correct_Case()
  Dim RX As Object, M As Object
  Dim a As Variant
  Dim i As Long
 
  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
  a = Selection.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
  Selection.Value = a
End Sub
Click to expand...


Apologies. I didn't get back sooner on this.

This appears to do exactly what is needed except for two things.

1. Is there a way to have it stop at the last row of data? On 50 lines, if i select the column itself, it hangs quite a bit.
2. This works great on a single column but if I use it on three column selection, it only converts the first column so if there is a first name, Middle Name and Last Name column, you have to do each one by one rather than select all three columns in a range and run the code.

And if i needed to add to the code, would I just add to the Const lines of code and add in there the upper or lower values needed?
 
Upvote 0
Serafin54 said:
1. Is there a way to have it stop at the last row of data? On 50 lines, if i select the column itself, it hangs quite a bit.
2. This works great on a single column but if I use it on three column selection, it only converts the first column so if there is a first name, Middle Name and Last Name column, you have to do each one by one rather than select all three columns in a range and run the code.
Click to expand...
Will you always be selecting a whole column or multiple whole columns?
If you are selecting more that one column will they always be adjacent columns?


Serafin54 said:
And if i needed to add to the code, would I just add to the Const lines of code and add in there the upper or lower values needed?
Click to expand...
That is the idea, but hard to guarantee without knowing what additions you want and exactly how you want them treated. So, best just to give it a go and report with examples if you have problems.
 
Upvote 0
Peter_SSs said:
Will you always be selecting a whole column or multiple whole columns?
If you are selecting more that one column will they always be adjacent columns?



That is the idea, but hard to guarantee without knowing what additions you want and exactly how you want them treated. So, best just to give it a go and report with examples if you have problems.
Click to expand...
More times than not it will be the entire column as there could be a blank hidden within a few hundred rows.

I would say the columns would be adjacent but if it could be addressed, easily, so that Ctrl selecting the columns is a possibility that might not be bad but if it's a ton of work in the code, keep it as adjacent as it's just one more click so nothing unrealistic.
 
Upvote 0
OK, try this adaptation. The columns do not need to be adjacent and you do not need to select whole columns, though it is fine to do so.
Note however, that the code will process all data in any column that has any cell(s) selected, stopping at the last cell with data as requested.
So, for example, if you wanted columns A:C and E processed then you could select all those columns, or you could just select say A2:C3 and E1
See how it goes.

VBA Code: 
Sub Correct_Case_v2()
  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
 
Upvote 0
Solution
Peter_SSs said:
OK, try this adaptation. The columns do not need to be adjacent and you do not need to select whole columns, though it is fine to do so.
Note however, that the code will process all data in any column that has any cell(s) selected, stopping at the last cell with data as requested.
So, for example, if you wanted columns A:C and E processed then you could select all those columns, or you could just select say A2:C3 and E1
See how it goes.

VBA Code: 
Sub Correct_Case_v2()
  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...
This is perfect and quick also!

Can you please tell me what the coding is that tells the VBA to go to the last row? I know it has to do with the lines
Code: 
  For Each col In Selection.EntireColumn.Columns

    With col.Resize(Cells(Rows.Count, col.Column).End(xlUp).Row)

      If .Rows.Count > 1 Then

but i assume the Dim col as Range is also included. For instance, say i have this code below, what would i alter to make this do the same assuming entire columns are going to be selected like the one in this thread? Or is it much more involved than that. Just trying to stand on my own. I appreciate the help.

VBA Code: 
Sub FORMATTING_Upper_Case()

    Dim Rng As Range

    For Each Rng In Selection

        Rng.Value = UCase(Rng.Value)

    Next Rng

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question
Clean Text - Remove Repeat Line Breaks
Replies
4
Views
207
lneidorf
L
M
  • Question
Saveas newwb, close new wb, delete old wb
Replies
8
Views
207
eiloken
E
S
  • Question
Parse data - Overwrite lines with updated data
Replies
0
Views
131
Scifo
S
F
  • Question
find and replace only within selection
Replies
3
Views
508
Fluff
Fluff
R
  • Solved
Excel VBA error when attempting to replace text that has multiple lines a cell
2
Replies
11
Views
395
Revco
R

Forum statistics

Threads
1,215,372
Messages
6,124,532
Members
449,169
Latest member
mm424

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