proper case end of string

[Serafin54]

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.

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

 

[Peter_SSs]

This is perfect and quick also!

Good news!

Can you please tell me what the coding is that tells the VBA to go to the last row?

Cells(Rows.Count, col.Column).End(xlUp).Row
This starts at the the very bottom of the worksheet (normally row 1,048,576) in the relevant column and comes up until it meets something in a cell and returns that row number.
So resizing the whole column to that number of rows gives the column range from row 1 to the last row with data in that column.

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?

You could do it like this

Sub FORMATTING_Upper_Case_v2a()
  Dim rng As Range, col As Range

  For Each col In Selection.EntireColumn.Columns
    For Each rng In col.Resize(Cells(Rows.Count, col.Column).End(xlUp).Row).Cells
      rng.Value = UCase(rng.Value)
    Next rng
  Next col
End Sub

So, lets say your sheet has 1000 rows of data and you have two disjoint columns selected.
Your original code would be looping through more than 2,000,000 cells!
The suggested code above would only need to loop through 2,000 cells, a significant saving.

However, even more savings could be made. In the same scenario the code below only needs to do 2 passes through the loop, converting whole blocks of values at a time to upper case.

Sub FORMATTING_Upper_Case_v2b()
  Dim rA As Range
  
  For Each rA In Intersect(Selection.EntireColumn, ActiveSheet.UsedRange).Areas
    rA.Value = Evaluate("upper(" & rA.Address & ")")
  Next rA
End Sub

 

[Serafin54]

Good news!


Cells(Rows.Count, col.Column).End(xlUp).Row
This starts at the the very bottom of the worksheet (normally row 1,048,576) in the relevant column and comes up until it meets something in a cell and returns that row number.
So resizing the whole column to that number of rows gives the column range from row 1 to the last row with data in that column.


You could do it like this

Sub FORMATTING_Upper_Case_v2a()
  Dim rng As Range, col As Range

  For Each col In Selection.EntireColumn.Columns
    For Each rng In col.Resize(Cells(Rows.Count, col.Column).End(xlUp).Row).Cells
      rng.Value = UCase(rng.Value)
    Next rng
  Next col
End Sub

So, lets say your sheet has 1000 rows of data and you have two disjoint columns selected.
Your original code would be looping through more than 2,000,000 cells!
The suggested code above would only need to loop through 2,000 cells, a significant saving.

However, even more savings could be made. In the same scenario the code below only needs to do 2 passes through the loop, converting whole blocks of values at a time to upper case.

Sub FORMATTING_Upper_Case_v2b()
  Dim rA As Range
 
  For Each rA In Intersect(Selection.EntireColumn, ActiveSheet.UsedRange).Areas
    rA.Value = Evaluate("upper(" & rA.Address & ")")
  Next rA
End Sub

Great. Thank you. The first code makes sense. I will google and dissect the second code so i can better understand why it does what it does. Thank you for your time!

 

[Serafin54]

Hi. Just an updated. I tried running this on a very small column of 12 names and it seems to hang quite a bit spinning the blue wheel. This doesn't happen if i manually select the cells themselves just when i select the column. Also, to your code, what and where would i add a +1 for it to begin at row two instead of including the header?

 

[Peter_SSs]

I tried running this on a very small column of 12 names and it seems to hang quite a bit spinning the blue wheel.

Also, to your code, what and where would i add a +1 for it to begin at row two instead of including the header?

I have posted a number of codes in the thread. Which one (or ones) are you referring to in relation to the parts I have bolded above?

 

[Serafin54]

I have posted a number of codes in the thread. Which one (or ones) are you referring to in relation to the parts I have bolded above?

Actually, I was having some other issues with Excel this morning such as my find and replace having a format set and my autosort already having horizontal sorting set, and weird VBA errors on codes i've used hundreds of times so i cleared my cache and now neither of your codes are hanging.

But the issue was with both the codes. Let's just say i am using the 2nd listed code, FORMATTING_Upper_Case_v2a since it is designed to be the faster of the two. Thank you.

 

[Peter_SSs]

Let's just say i am using the 2nd listed code, FORMATTING_Upper_Case_v2a since it is designed to be the faster of the two.

Like this then?

Sub FORMATTING_Upper_Case_v2a1()
  Dim rng As Range, col As Range

  For Each col In Selection.EntireColumn.Columns
    For Each rng In col.Resize(Cells(Rows.Count, col.Column).End(xlUp).Row).Cells
      If rng.Row > 1 Then rng.Value = UCase(rng.Value)
    Next rng
  Next col
End Sub

 

[Serafin54]

Like this then?

Sub FORMATTING_Upper_Case_v2a1()
  Dim rng As Range, col As Range

  For Each col In Selection.EntireColumn.Columns
    For Each rng In col.Resize(Cells(Rows.Count, col.Column).End(xlUp).Row).Cells
      If rng.Row > 1 Then rng.Value = UCase(rng.Value)
    Next rng
  Next col
End Sub

yes. So all that is needed is the "If rng.Row> 1" statement?

And my apologies, i was informed by my coworker that the initial Correct_Case_v2 code does in fact hang. I hadn't had much time to test it out prior to last night but ran on several reports after clearing cache and this seems to be a true issue.

I really thank you for your help. I believe I will be spending the next few nights on Udemy so i can digest what i am seeing.

 

[Peter_SSs]

So all that is needed is the "If rng.Row> 1" statement?

Well, that was a "quick fix" as I didn't have a lot of time when posting that. It works fine, but if you had 1000 rows, doing that check for every row seems inefficient.
Probably a better way would be something like this

Sub FORMATTING_Upper_Case_v2a2()
  Dim rng As Range, col As Range

  For Each col In Selection.EntireColumn.Columns
    For Each rng In col.Resize(Cells(Rows.Count, col.Column).End(xlUp).Row - 1).Offset(1).Cells
      rng.Value = UCase(rng.Value)
    Next rng
  Next col
End Sub

I have not been able to reproduce the 'hanging' that you described. I assume that it is something particular with your file and/or data and/or machine.

If you want to investigate that further, are you able to upload a smallish file that has no sensitive data but is hanging for you to DropBox or OneDrive etc and provide a public shared link here so that we could take a look?

 

[Serafin54]

Well, that was a "quick fix" as I didn't have a lot of time when posting that. It works fine, but if you had 1000 rows, doing that check for every row seems inefficient.
Probably a better way would be something like this

Sub FORMATTING_Upper_Case_v2a2()
  Dim rng As Range, col As Range

  For Each col In Selection.EntireColumn.Columns
    For Each rng In col.Resize(Cells(Rows.Count, col.Column).End(xlUp).Row - 1).Offset(1).Cells
      rng.Value = UCase(rng.Value)
    Next rng
  Next col
End Sub

I have not been able to reproduce the 'hanging' that you described. I assume that it is something particular with your file and/or data and/or machine.

If you want to investigate that further, are you able to upload a smallish file that has no sensitive data but is hanging for you to DropBox or OneDrive etc and provide a public shared link here so that we could take a look?

Here is a dummy file i just created. I tried the Correct Case vba on it and it hangs. It will put the values in proper case but then locks up.

Correct Case dummy file

 

[Peter_SSs]

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)?