Solved Text to Columns based on all Upper CAse

August 12, 2016 at 01:51:54
Specs: Windows 7
If I have data in excel that needs to be separated into columns that looks like this:

18SampleStreetBIGTOWN
18SampleLittleStreetLITTLETOWN

With the data wanting to look like:
18 Sample Street BIGTOWN
18 Sample Little Street LITTLETOWN

Is there a way to separate the town which is all in Capitals?
Thanks
Robyn

message edited by Robyn69


See More: Text to Columns based on all Upper CAse

Reply ↓  Report •


✔ Best Answer
August 14, 2016 at 16:27:19
This should work for the example data that you posted in Response #6. I have no idea if it will work for a larger set of data, especially if there are any other formats that you have not shown.

You have a PO Box, 2 "standard" house number-street name addresses, a house number with a slash that I assume is supposed to remain as a house number and text with a slash that you say belongs in the street name column. To a certain extent, each of those had to be dealt with, and coded for, almost individually. If you toss in any other formats, I can't say what will happen.

In any case, if you paste the data from response #6 into Column A (A1:A5) of a new spreadsheet and then run the following code, you should end up with 2 tables:

1 - A Text-To-Columns table, delimited by spaces (done by the code, not the user)

2 - A table of data like this:

    N         O                       P             Q
1          PO Box 11               LTOWN NSW       2222
2  16      Jones Way               PTOWN NSW       2222
3  30      Jones Jay Street        PORT TOWN NSW   2222
4  18/380  Jones Johnson Road      PORT TOWN NSW   2222
5          C/- Reale Estate Jones  PORT TOWN NSW   2222

Sub AlignAddressParts()
'Perform Text-To_Columns on Column A
    Columns("A:A").TextToColumns Destination:=Range("A1"), _
    DataType:=xlDelimited, Space:=True
'Determine Last Row with data in Column A
    lastSrcRw = Cells(Rows.Count, 1).End(xlUp).Row
'Loop through Rows to determine last Column in longest row
     For rw = 1 To lastSrcRw
       tmpLastCol = Cells(rw, Columns.Count).End(xlToLeft).Column
         If tmpLastCol > lastCol Then lastCol = tmpLastCol
     Next
'Set Last Destination Column (Zip Codes will go here)
     dstCol = 1 + lastCol * 2
'Loop through Rows, building strings and moving data
     For rw = 1 To lastSrcRw
'Determine Last cell with Data in current Row
       lastCol = Cells(rw, Columns.Count).End(xlToLeft).Column
'Move Zip to Last Destination Column
         Cells(rw, dstCol) = Cells(rw, lastCol)
'Loop through Columns in current Row
           For col = lastCol - 1 To 1 Step -1
'Build String of contiguous Upper Case cells
            If Cells(rw, col) = UCase(Cells(rw, col)) Then
              tmpUcaseStr = Cells(rw, col) & " " & tmpUcaseStr
            Else:
'Place Upper Case string in Column before Zip Codes
              Cells(rw, dstCol - 1) = tmpUcaseStr
              tmpUcaseStr = ""
'Build string from left over data
               For lo = 1 To col
                loStr = loStr & Cells(rw, lo) & " "
               Next
'If the first part of the Left Over string is a number or
'a number containing a "/", then separate the number
'portion from the street name portion.
                If IsNumeric(Left(loStr, InStr(loStr, " ") - 1)) Or _
                   IsNumeric(Mid(loStr, InStr(loStr, " ") - 1, 1)) And _
                   InStr(loStr, "/") > 0 Then
                      Cells(rw, dstCol - 2) = _
                            Right(loStr, Len(loStr) - InStr(loStr, " "))
                      Cells(rw, dstCol - 3) = _
                            Left(loStr, InStr(loStr, " "))
                Else: Cells(rw, dstCol - 2) = loStr
                End If
                 loStr = ""
                 Exit For
            End If
           Next
     Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.



#1
August 12, 2016 at 04:25:55
I'm a little confused. Your specific question only relates to the "town" portion of your string, yet your desired outcome shows the string separated at each change to uppercase.

Which is it?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Reply ↓  Report •

#2
August 12, 2016 at 09:07:57
I have 2 possible solutions to offer.

1 - Assuming you want the output to look like this, the first macro found below might work for you.

18 Sample Street BIGTOWN
18 Sample Little Street LITTLETOWN

2 - If you want this output, the second macro might be better:

18SampleStreet BIGTOWN
18SampleLittleStreet LITTLETOWN

This first macro will insert a space before each uppercase letter in the cell with the following exception: If the code encounters contiguous uppercase letters, it will stop checking and move on to the next cell. That seems to match the requirements based on your example data.

Once the spaces have been inserted, you can use the Text-To-Column feature, delimited by a Space, to split the data into multiple columns.

Your output should look like this:

18 Sample Street BIGTOWN

Sub AddSpaceUcase_V1()
Dim lastRW As Long, rw As Long, c As Long
'Determine last Row with data in Column A
  lastRW = Cells(Rows.Count, 1).End(xlUp).Row
'Loop through data in Column A
   For rw = 1 To lastRW
'Loop through characters in cell checking for Uppercase, Ignore numbers
     For c = 1 To Len(Cells(rw, 1))
      If Not IsNumeric(Mid(Cells(rw, 1), c, 1)) Then
        If UCase(Mid(Cells(rw, 1), c, 1)) = Mid(Cells(rw, 1), c, 1) Then
'Add a space before the Uppercase letter
          Cells(rw, 1) = Left(Cells(rw, 1), c - 1) & _
                         " " & Right(Cells(rw, 1), Len(Cells(rw, 1)) - c + 1)
          c = c + 1
'Stop checking cell is consecutive Uppercase letters are found
            If Asc(Mid(Cells(rw, 1), c, 1)) <= 90 And _
               Asc(Mid(Cells(rw, 1), c + 1, 1)) <= 90 Then Exit For
        End If
      End If
     Next
   Next
End Sub

The following macro will only insert a space before the contiguous uppercase letters in your original data. Your output should look like this:

18SampleStreet BIGTOWN

Sub AddSpaceUcase_V2()
Dim lastRW As Long, rw As Long, c As Long
'Determine last Row with data in Column A
  lastRW = Cells(Rows.Count, 1).End(xlUp).Row
'Loop through data in Column A
   For rw = 1 To lastRW
'Loop through characters in cell, starting at end of string,
'checking for change from Uppercase to Lowercase
     For c = Len(Cells(rw, 1)) To 1 Step -1
        If Asc(Mid(Cells(rw, 1), c, 1)) <= 90 And _
           Asc(Mid(Cells(rw, 1), c - 1, 1)) > 90 Then
'Add a space before the Uppercase letter
          Cells(rw, 1) = Left(Cells(rw, 1), c - 1) & _
                         " " & Right(Cells(rw, 1), Len(Cells(rw, 1)) - c + 1)
          Exit For
      End If
     Next
   Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Reply ↓  Report •

#3
August 12, 2016 at 14:19:32
Hi
Many thanks. What I am really after is that the words all in uppercase all end up in the same column. The problem is that there can be differing numbers of words before them. So when I split the column, different towns in upper case all end up in different column, but I want just one column with towns.
Thankyou!

Reply ↓  Report •

Related Solutions

#4
August 12, 2016 at 14:41:30
Use my second macro to get results like this, then just use Text-To-Columns on the result.

18SampleStreet BIGTOWN

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Reply ↓  Report •

#5
August 12, 2016 at 23:04:49
Thankyou so much - that is fabulous!

Reply ↓  Report •

#6
August 13, 2016 at 00:26:00
Hi,
Any suggestions if the data looks like below-(there are spaces between each word and number, but it is a mix of formats)I am trying to split the street number, Street name, town, state and post code out - so that they align in the same columns eg all towns in the same column, all states same colum etc. If it was a C/- that would go under the street name column. When I text to columns the text such as 18/380 returns a date, so I haven't been able to split it out to start. I was then going to concatenate everything bar the street number all together without spaces so I could use the macro but the columns to text won't even work. Thanyou!

PO Box 11 LTOWN NSW 2222
16 Jones Way PTOWN NSW 2222
30 Jones Jay Street PORT TOWN NSW 2222
18/380 Jones Johnson Road PORT TOWN NSW 2222
C/- Reale Estate Jones PORT TOWN NSW 2222


Reply ↓  Report •

#7
August 13, 2016 at 08:22:42
First, I kind of expected you to repost more examples of addresses that my code would not work for. In the future, when posting in a help forum such as this, please try to include as many of your overall requirements as possible. A lot of the time I spent working on your originally stated requirements was somewhat of a waste of time because I now have to edit it extensively and maybe even throw entire sections away.

If there is anything else that you think I need to know about your addresses and desired output, please let me know so that I can include those requirements as I try to find a solution.

Second, one thing that many Excel users don't think about is this:

Excel was never designed to be a "text editor". While it does include many text related features and functions, they are there more as a convenience than a priority.

Once you start getting into inconsistent text structures like yours, things get messy. There isn't really a way to deal with the myriad of possible constructs for an address, a name, etc. Quite often we have to settle for "that almost works" and then do some manual cleanup. Sometimes it can be “automated” but not with a one step/one click solution.

I’ll work on something as time allows this weekend, but please be patient and don’t expect a complete, one step solution.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Reply ↓  Report •

#8
August 13, 2016 at 18:19:57
Thankyou - I really appreciate all of your help, and apologies for not being more specific.

Reply ↓  Report •

#9
August 14, 2016 at 16:27:19
✔ Best Answer
This should work for the example data that you posted in Response #6. I have no idea if it will work for a larger set of data, especially if there are any other formats that you have not shown.

You have a PO Box, 2 "standard" house number-street name addresses, a house number with a slash that I assume is supposed to remain as a house number and text with a slash that you say belongs in the street name column. To a certain extent, each of those had to be dealt with, and coded for, almost individually. If you toss in any other formats, I can't say what will happen.

In any case, if you paste the data from response #6 into Column A (A1:A5) of a new spreadsheet and then run the following code, you should end up with 2 tables:

1 - A Text-To-Columns table, delimited by spaces (done by the code, not the user)

2 - A table of data like this:

    N         O                       P             Q
1          PO Box 11               LTOWN NSW       2222
2  16      Jones Way               PTOWN NSW       2222
3  30      Jones Jay Street        PORT TOWN NSW   2222
4  18/380  Jones Johnson Road      PORT TOWN NSW   2222
5          C/- Reale Estate Jones  PORT TOWN NSW   2222

Sub AlignAddressParts()
'Perform Text-To_Columns on Column A
    Columns("A:A").TextToColumns Destination:=Range("A1"), _
    DataType:=xlDelimited, Space:=True
'Determine Last Row with data in Column A
    lastSrcRw = Cells(Rows.Count, 1).End(xlUp).Row
'Loop through Rows to determine last Column in longest row
     For rw = 1 To lastSrcRw
       tmpLastCol = Cells(rw, Columns.Count).End(xlToLeft).Column
         If tmpLastCol > lastCol Then lastCol = tmpLastCol
     Next
'Set Last Destination Column (Zip Codes will go here)
     dstCol = 1 + lastCol * 2
'Loop through Rows, building strings and moving data
     For rw = 1 To lastSrcRw
'Determine Last cell with Data in current Row
       lastCol = Cells(rw, Columns.Count).End(xlToLeft).Column
'Move Zip to Last Destination Column
         Cells(rw, dstCol) = Cells(rw, lastCol)
'Loop through Columns in current Row
           For col = lastCol - 1 To 1 Step -1
'Build String of contiguous Upper Case cells
            If Cells(rw, col) = UCase(Cells(rw, col)) Then
              tmpUcaseStr = Cells(rw, col) & " " & tmpUcaseStr
            Else:
'Place Upper Case string in Column before Zip Codes
              Cells(rw, dstCol - 1) = tmpUcaseStr
              tmpUcaseStr = ""
'Build string from left over data
               For lo = 1 To col
                loStr = loStr & Cells(rw, lo) & " "
               Next
'If the first part of the Left Over string is a number or
'a number containing a "/", then separate the number
'portion from the street name portion.
                If IsNumeric(Left(loStr, InStr(loStr, " ") - 1)) Or _
                   IsNumeric(Mid(loStr, InStr(loStr, " ") - 1, 1)) And _
                   InStr(loStr, "/") > 0 Then
                      Cells(rw, dstCol - 2) = _
                            Right(loStr, Len(loStr) - InStr(loStr, " "))
                      Cells(rw, dstCol - 3) = _
                            Left(loStr, InStr(loStr, " "))
                Else: Cells(rw, dstCol - 2) = loStr
                End If
                 loStr = ""
                 Exit For
            End If
           Next
     Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Reply ↓  Report •

#10
August 15, 2016 at 00:59:12
Thankyou very very much
Much appreciated

Reply ↓  Report •


Ask Question