Seperate city and state from 1 to 2 cells

[Daniyielle]

Hello,

I have to export data from a pdf invoice in order to re-rate calls that billed incorrectly; however, in order to do so, I had to essentially create a macro similar to text to columns to move the data from one cell across multiple cells. So far, I have the macro working like I want, but I am stuck when it comes to the city and state (this is imperative to determine the rates that would be received). I have searched this forum and found a similar post http://www.mrexcel.com/forum/showthread.php?t=60205. This may work if the data was primarily city, state and zip codes. The problem is, my data does not consist of zip codes, there are no comma deliminators (I wouldn't have this problem if there were) and in some instances can contain countries. There are even some instances where the city and state do not have a space between them. If someone can assist me with trying to create a macro to complete this, I would be greatly appreciated.

Here is an example of the column of data I wish to separate.

<table border="0" cellpadding="0" cellspacing="0" width="103"><colgroup><col style="mso-width-source:userset;mso-width-alt:3766;width:77pt" width="103"> </colgroup><tbody><tr style="height:12.75pt" height="17"> <td style="height:12.75pt;width:77pt" height="17" width="103">New York NY</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">Trenton NJ</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">Trenton NJ</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">Nwyrcyzn01NY</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">Un Kingdom</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">Nwyrcyzn01NY</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">Nwyrcyzn01NY</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">CHICGOZN01IL</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">Un Kingdom</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">New York NY</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">Moorestown NJ</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">New York NY</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">New York NY</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">New York NY</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">Lsan Da 13 CA</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">Un Kingdom</td> </tr> <tr style="height:12.75pt" height="17"> <td style="height:12.75pt" height="17">New York NY</td> </tr> </tbody></table>

 

[Leith Ross]

Hello Daniyielle,

I did find the problem you mentioned and have corrected it in the code. The macro now allows you to control case sensitivity in matching the states. Currently, case sensitivity is ignored. Screen updating is turned off until the macro has finished running. This removes screen flicker when there is a lot of data.

Here is the corrected macro.

Sub SplitCityAndState()

    Dim Cell As Range
    Dim RegExp As Object
    Dim Rng As Range
    Dim RngEnd As Range
    Dim State As String
    Dim Wks As Worksheet
    
  ' List covers all states, US possessions, and military base "states".
    Const States As String = "A[AELKPSZ]|C[AOT]|D[EC]|FL|G[AU]|HI|I[ADLN]|" _
                           & "K[SY]|LA|M[AEDINOST]|N[CDEHJMY]|O[HKR]|P[AR]|RI|S[CD]|" _
                           & "T[NX]|V[AT]|W[AIVY]"
                           
        Set Wks = ActiveSheet
        
        Set Rng = Wks.Range("A1")
        
            Set RngEnd = Wks.Cells(Rows.Count, Rng.Column)
            If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Wks.Range(Rng, RngEnd)

            Set RegExp = CreateObject("VBScript.RegExp")
            RegExp.IgnoreCase = True
            RegExp.Pattern = States
            
            Application.ScreenUpdating = False
            
                For Each Cell In Rng
                    State = Right(Cell, 2)
                    If RegExp.Test(State) = True Then
                       Cell = Replace(Cell, State, "")
                      Cell.Offset(0, 1) = State
                    End If
                Next Cell
            
            Application.ScreenUpdating = True
        
End Sub

 

[Daniyielle]

Thank you all for your input!!! The first set of UDF worked! It's Amazing!

I was able to add that in to my macro, which is now complete. I keep running it, then closing it just to open it and run it again. It is just so beautiful.