Excel problem that could be solved with VBA

[aldo jr]

Can anyone please help. I am working with a software that outputs zip
code and street information. The output information is excel based.
The problem that i have is that in the same column (for ex. column A)
both the zip and street information is listed.

The pattern of the output file consists of a zip code followed by
multiple streets that belong to that zip code. This pattern repeats
numerous times. So, for instance:

94015
Amhurst Ct
Arcadia Dr
Arley Ct
Avalon Dr
Bacon Ct
..
..
..
94015
Gateway Dr
Gellert Blvd
Glencourt Way
Grandview Ave
Hampshire Ave
Hampshire Ct
..
..
..

The file has approximately 10,000 rows/records of this zip codes plus
multiple zips sequence within the same column. Ultimately what i need
to do is to create another column with only the zip code information
for those respective streets under that zip code. This becomes very
tedious and painful when working of a list of over 10,000 rows/records
when referencing the zip code cell from another cell in another
column.

Does anyone know an excel formula (not sure if an excel formula will
do it) that will automate this task of separating the zip code to
another column for the respective bucket of streets? I think that VBA
will do it but I do not know VBA.

 

[pietlinden]

Can anyone please help.  I am working with a software that outputs zip
code and street information.  The output information is excel based.
The problem that i have is that in the same column (for ex. column A)
both the zip and street information is listed.

The pattern of the output file consists of a zip code followed by
multiple streets that belong to that zip code.  This pattern repeats
numerous times. So, for instance:

94015
Amhurst Ct
Arcadia Dr
Arley Ct
Avalon Dr
Bacon Ct
.
.
.
94015
Gateway Dr
Gellert Blvd
Glencourt Way
Grandview Ave
Hampshire Ave
Hampshire Ct
.
.
.

The file has approximately 10,000 rows/records of this zip codes plus
multiple zips sequence within the same column.  Ultimately what i need
to do is to create another column with only the zip code information
for those respective streets under that zip code.  This becomes very
tedious and painful when working of a list of over 10,000 rows/records
when referencing the zip code cell from another cell in another
column.

Does anyone know an excel formula (not sure if an excel formula will
do it) that will automate this task of separating the zip code to
another column for the respective bucket of streets? I think that VBA
will do it but I do not know VBA.

this worked on the data you provided... but in Access... I didn't try
it in Excel.

'rsRead is reading from an attached text file
'rsWrite is writing to a table, StreetZipCodes, with two columns
(ZipCode, StreetName)

Public Sub ProcessStreetZipCodes()
Dim rsRead As DAO.Recordset
Dim rsWrite As DAO.Recordset

Dim strZIP As String
Dim strStreet As String

Set rsRead = DBEngine(0)(0).OpenRecordset("testaddress",
dbOpenSnapshot)
Set rsWrite = DBEngine(0)(0).OpenRecordset("StreetZipCodes",
dbOpenTable, dbAppendOnly)
Do Until rsRead.EOF
If IsNumeric(rsRead.Fields(0)) Then
'Debug.Print "ZIP: " & rs.Fields(0)
strZIP = CStr(rsRead.Fields(0))
Else
strStreet = rsRead.Fields(0)
Debug.Print strZIP & vbTab & "Street: " & rsRead.Fields(0)
With rsWrite
.AddNew
.Fields("ZipCode") = strZIP
.Fields("StreetName") = strStreet
.Update
End With


End If

rsRead.MoveNext
Loop
rsRead.Close
Set rsRead = Nothing
rsWrite.Close
Set rsWrite = Nothing

End Sub

Perhaps not the answer you wanted, but it worked a champ for me. If
the file's not too huge and you don't have Access, you could e-mail it
as an attachment and I could do it here and send it back.

 

[Ron Rosenfeld]

Can anyone please help. I am working with a software that outputs zip
code and street information. The output information is excel based.
The problem that i have is that in the same column (for ex. column A)
both the zip and street information is listed.

The pattern of the output file consists of a zip code followed by
multiple streets that belong to that zip code. This pattern repeats
numerous times. So, for instance:

94015
Amhurst Ct
Arcadia Dr
Arley Ct
Avalon Dr
Bacon Ct
.
.
.
94015
Gateway Dr
Gellert Blvd
Glencourt Way
Grandview Ave
Hampshire Ave
Hampshire Ct
.
.
.

The file has approximately 10,000 rows/records of this zip codes plus
multiple zips sequence within the same column. Ultimately what i need
to do is to create another column with only the zip code information
for those respective streets under that zip code. This becomes very
tedious and painful when working of a list of over 10,000 rows/records
when referencing the zip code cell from another cell in another
column.

Does anyone know an excel formula (not sure if an excel formula will
do it) that will automate this task of separating the zip code to
another column for the respective bucket of streets? I think that VBA
will do it but I do not know VBA.

If your data starts in A1, then enter this formula in B1 and fill down.

It will leave a blank where just the original zip code exists.

I assumed your "dots" were actually street entries.

I also assumed your zip codes were in the format of 5 or 5+4 with or without
the hyphen and that they were entered as text strings (so as to avoid the
dropping of leading zero's issue).

=IF(OR(A1="",AND(ISNUMBER(-SUBSTITUTE(A1,"-","")),
OR(LEN(A1=5),LEN(A1=9),LEN(A1=10)))),"",LOOKUP(
2,1/ISNUMBER(-SUBSTITUTE($A$1:A1,"-","")),$A$1:A1))




--ron

 

[kounoike]

I'm not quite sure this is what you want, but try this one.
Activate your datasheet and run macro testzip, then it will add worksheet
after your datasheet and will put the result in it.
i assume your date reside in column A.

Sub testzip()
Dim startcell As Range, endcell As Range
Dim targetcell As Range, zipcell As Range
Dim discell As Range
Dim srcsh As Worksheet, dstsh As Worksheet
Dim n As Long, x As Long

Set srcsh = ActiveSheet
Set dstsh = Worksheets.Add(after:=srcsh)
Set dstcell = dstsh.Range("A1") '<=Change here

srcsh.Select
Set targetcell = Range("A1") '<=Change here

Set endcell = targetcell
n = Cells(Cells.Rows.Count, "A").End(xlUp).Row

Do While endcell.Row <= n
Do While Not Iszipcode(targetcell) And targetcell.Row <= n
Set targetcell = targetcell.Offset(1, 0)
Loop

Set zipcell = targetcell
Set startcell = zipcell.Offset(1, 0)
Set targetcell = targetcell.Offset(1, 0)

Do While Not Iszipcode(targetcell) And targetcell.Row <= n
Set targetcell = targetcell.Offset(1, 0)
Loop

Set endcell = targetcell.Offset(-1, 0)
Set targetcell = endcell.Offset(1, 0)

If zipcell.Row <> endcell.Row Then
x = Range(startcell, endcell).Rows.Count
dstcell.Resize(x).Value = zipcell.Value
dstcell.Offset(0, 1).Resize(x).Value = _
Range(startcell, endcell).Value
Set dstcell = dstcell.Offset(x, 0)
End If
Loop
End Sub

Function Iszipcode(rng As Range) As Boolean
Dim s
s = Split(rng, "-")
Select Case UBound(s)
Case 0
If IsNumeric(s(0)) And Len(s(0)) = 5 Then
Iszipcode = True
Else
Iszipcode = False
End If
Case 1
If IsNumeric(s(0)) And Len(s(0)) = 5 _
And IsNumeric(s(1)) And Len(s(1)) = 4 Then
Iszipcode = True
Else
Iszipcode = False
End If
Case Else
Iszipcode = False
End Select
End Function

keiji

 

[aldo jr]

I'm not quite sure this is what you want, but try this one.
Activate your datasheet and run macro testzip, then it will add worksheet
after your datasheet and will put the result in it.
i assume your date reside in column A.

Sub testzip()
Dim startcell As Range, endcell As Range
Dim targetcell As Range, zipcell As Range
Dim discell As Range
Dim srcsh As Worksheet, dstsh As Worksheet
Dim n As Long, x As Long

Set srcsh = ActiveSheet
Set dstsh = Worksheets.Add(after:=srcsh)
Set dstcell = dstsh.Range("A1") '<=Change here

srcsh.Select
Set targetcell = Range("A1") '<=Change here

Set endcell = targetcell
n = Cells(Cells.Rows.Count, "A").End(xlUp).Row

Do While endcell.Row <= n
    Do While Not Iszipcode(targetcell) And targetcell.Row <= n
        Set targetcell = targetcell.Offset(1, 0)
    Loop

    Set zipcell = targetcell
    Set startcell = zipcell.Offset(1, 0)
    Set targetcell = targetcell.Offset(1, 0)

    Do While Not Iszipcode(targetcell) And targetcell.Row <= n
        Set targetcell = targetcell.Offset(1, 0)
    Loop

    Set endcell = targetcell.Offset(-1, 0)
    Set targetcell = endcell.Offset(1, 0)

    If zipcell.Row <> endcell.Row Then
        x = Range(startcell, endcell).Rows.Count
        dstcell.Resize(x).Value = zipcell.Value
        dstcell.Offset(0, 1).Resize(x).Value = _
            Range(startcell, endcell).Value
        Set dstcell = dstcell.Offset(x, 0)
    End If
Loop
End Sub

Function Iszipcode(rng As Range) As Boolean
Dim s
s = Split(rng, "-")
Select Case UBound(s)
Case 0
    If IsNumeric(s(0)) And Len(s(0)) = 5 Then
        Iszipcode = True
    Else
        Iszipcode = False
    End If
Case 1
    If IsNumeric(s(0)) And Len(s(0)) = 5 _
        And IsNumeric(s(1)) And Len(s(1)) = 4 Then
        Iszipcode = True
    Else
        Iszipcode = False
    End If
Case Else
    Iszipcode = False
End Select
End Function

keiji










- Show quoted text -

Thanks.

 

[aldo jr]

I'm not quite sure this is what you want, but try this one.
Activate your datasheet and run macro testzip, then it will add worksheet
after your datasheet and will put the result in it.
i assume your date reside in column A.

Sub testzip()
Dim startcell As Range, endcell As Range
Dim targetcell As Range, zipcell As Range
Dim discell As Range
Dim srcsh As Worksheet, dstsh As Worksheet
Dim n As Long, x As Long

Set srcsh = ActiveSheet
Set dstsh = Worksheets.Add(after:=srcsh)
Set dstcell = dstsh.Range("A1") '<=Change here

srcsh.Select
Set targetcell = Range("A1") '<=Change here

Set endcell = targetcell
n = Cells(Cells.Rows.Count, "A").End(xlUp).Row

Do While endcell.Row <= n
    Do While Not Iszipcode(targetcell) And targetcell.Row <= n
        Set targetcell = targetcell.Offset(1, 0)
    Loop

    Set zipcell = targetcell
    Set startcell = zipcell.Offset(1, 0)
    Set targetcell = targetcell.Offset(1, 0)

    Do While Not Iszipcode(targetcell) And targetcell.Row <= n
        Set targetcell = targetcell.Offset(1, 0)
    Loop

    Set endcell = targetcell.Offset(-1, 0)
    Set targetcell = endcell.Offset(1, 0)

    If zipcell.Row <> endcell.Row Then
        x = Range(startcell, endcell).Rows.Count
        dstcell.Resize(x).Value = zipcell.Value
        dstcell.Offset(0, 1).Resize(x).Value = _
            Range(startcell, endcell).Value
        Set dstcell = dstcell.Offset(x, 0)
    End If
Loop
End Sub

Function Iszipcode(rng As Range) As Boolean
Dim s
s = Split(rng, "-")
Select Case UBound(s)
Case 0
    If IsNumeric(s(0)) And Len(s(0)) = 5 Then
        Iszipcode = True
    Else
        Iszipcode = False
    End If
Case 1
    If IsNumeric(s(0)) And Len(s(0)) = 5 _
        And IsNumeric(s(1)) And Len(s(1)) = 4 Then
        Iszipcode = True
    Else
        Iszipcode = False
    End If
Case Else
    Iszipcode = False
End Select
End Function

keiji










- Show quoted text -

keiji,

Thank you. The VBA code works it splits the zip and street info
that's embedded in column A into separate columns in another sheet.
Now, what if I've got additional column/field information (ex. Columns
B to Column F) for those streets that i want to transfer over to my
destination sheet? What additional code would i need to integrate?

Sample data set:

Column A Column B Column C Coumn D
Column F
Zipcode/Streets Low High
Edge Route

94015
Amhurst Ct 1 97
both 10A
Arcadia Dr 1 98
both 10A
Arley Ct 10 98
both 10A
Avalon Dr 1 98
both 10A
Bacon Ct 79 980
both 10A
. . . . .
. . . . .
. . . . .
94018
Lion Ct 5 57
both 10A
Arcadia Dr 1 98
both 10A
Embarcadero Ct 16 38
both 10A
Avalon Dr 100 400
both 10A
Leaf Ct 79 980
both 10A
. . . . .
. . . . .
. . . . .
n n n
n n

Where n goes over 10,000 records of this pattern of sequence.

I know i can probably manually copy and paste this but I am concerned
that the row/record street information will not be aligned properly.

 

[kounoike]

I'm not quite sure this is what you want, but try this one.
Activate your datasheet and run macro testzip, then it will add worksheet
after your datasheet and will put the result in it.
i assume your date reside in column A.

Sub testzip()
Dim startcell As Range, endcell As Range
Dim targetcell As Range, zipcell As Range
Dim discell As Range
Dim srcsh As Worksheet, dstsh As Worksheet
Dim n As Long, x As Long

Set srcsh = ActiveSheet
Set dstsh = Worksheets.Add(after:=srcsh)
Set dstcell = dstsh.Range("A1") '<=Change here

srcsh.Select
Set targetcell = Range("A1") '<=Change here

Set endcell = targetcell
n = Cells(Cells.Rows.Count, "A").End(xlUp).Row

Do While endcell.Row <= n
Do While Not Iszipcode(targetcell) And targetcell.Row <= n
Set targetcell = targetcell.Offset(1, 0)
Loop

Set zipcell = targetcell
Set startcell = zipcell.Offset(1, 0)
Set targetcell = targetcell.Offset(1, 0)

Do While Not Iszipcode(targetcell) And targetcell.Row <= n
Set targetcell = targetcell.Offset(1, 0)
Loop

Set endcell = targetcell.Offset(-1, 0)
Set targetcell = endcell.Offset(1, 0)

If zipcell.Row <> endcell.Row Then
x = Range(startcell, endcell).Rows.Count
dstcell.Resize(x).Value = zipcell.Value
dstcell.Offset(0, 1).Resize(x).Value = _
Range(startcell, endcell).Value
Set dstcell = dstcell.Offset(x, 0)
End If
Loop
End Sub

Function Iszipcode(rng As Range) As Boolean
Dim s
s = Split(rng, "-")
Select Case UBound(s)
Case 0
If IsNumeric(s(0)) And Len(s(0)) = 5 Then
Iszipcode = True
Else
Iszipcode = False
End If
Case 1
If IsNumeric(s(0)) And Len(s(0)) = 5 _
And IsNumeric(s(1)) And Len(s(1)) = 4 Then
Iszipcode = True
Else
Iszipcode = False
End If
Case Else
Iszipcode = False
End Select
End Function

keiji










- Show quoted text -

keiji,

Thank you. The VBA code works it splits the zip and street info
that's embedded in column A into separate columns in another sheet.
Now, what if I've got additional column/field information (ex. Columns
B to Column F) for those streets that i want to transfer over to my
destination sheet? What additional code would i need to integrate?

Sample data set:

Column A Column B Column C Coumn D
Column F
Zipcode/Streets Low High
Edge Route

94015
Amhurst Ct 1 97
both 10A

--snip

Hi aldo
add the code into macro testzip as described below and see if it works or
not.

If zipcell.Row <> endcell.Row Then
x = Range(startcell, endcell).Rows.Count
dstcell.Resize(x).Value = zipcell.Value
dstcell.Offset(0, 1).Resize(x).Value = _
Range(startcell, endcell).Value

'add here the code below
dstcell.Offset(0, 2).Resize(x, 4).Value = _
Range(startcell, endcell).Offset(0, 1).Resize(x, 4).Value

Set dstcell = dstcell.Offset(x, 0)
End If

keiji

 

[aldo jr]

keiji,

Thank you. The VBA code works it splits the zip and street info
that's embedded in column A into separate columns in another sheet.
Now, what if I've got additional column/field information (ex. Columns
B to Column F) for those streets that i want to transfer over to my
destination sheet? What additional code would i need to integrate?

Sample data set:

Column A Column B Column C Coumn D
Column F
Zipcode/Streets Low High
Edge Route

94015
Amhurst Ct 1 97
both 10A

--snip

Hi aldo
add the code into macro testzip as described below and see if it works or
not.


'add here the code below
dstcell.Offset(0, 2).Resize(x, 4).Value = _
Range(startcell, endcell).Offset(0, 1).Resize(x, 4).Value


keiji

Keiji you're the man. Thank you.

 

[kounoike]

Keiji you're the man. Thank you.

Thank you for letting me know it worked.

 

[aldo jr]

Thank you for letting me know it worked.

Keiji what code would i need to alter if instead of zip manipulation
to copy over and split i copy over a number, number, and letter text
string. A Three character code of let's say "10A", "12D", and "15K"

Sample data set:

10A
Gateway Dr
Gellert Blvd
Glencourt Way
Grandview Ave
Hampshire Ave
Hampshire Ct
..
..
..
10C
Gateway Dr
Gellert Blvd
Glencourt Way
Grandview Ave
Hampshire Ave
Hampshire Ct
..
..
..
n

 

[kounoike]

Keiji what code would i need to alter if instead of zip manipulation
to copy over and split i copy over a number, number, and letter text
string. A Three character code of let's say "10A", "12D", and "15K"

Sample data set:

10A
Gateway Dr
Gellert Blvd
Glencourt Way
Grandview Ave
Hampshire Ave
Hampshire Ct

--snip

the easiest way of doing this is to change function zipcode to check your
code, because this function checks if cell's value is zipcode or not.
i can't find what is the rule of your code, so i assumed that code has three
characters and first two letter is number and last letter is greater/equal
than "A" and lesser/equal than "Z". then, add a function Checkcode below
and replace function Iszipcode with function Checkcode.

Add Checkcode below

Function Checkcode(rng As Range) As Boolean
If Len(rng.Value) = 3 Then
If IsNumeric(left(rng.Value, 2)) And _
"A" <= right(rng.Value, 1) And _
"Z" >= right(rng.Value, 1) Then
Checkcode = True
Else
Checkcode = False
End If
Else
Checkcode = False
End If
End Function

Rreplace function Iszipcode with function Checkcode as below.

Change the code below
Do While Not Iszipcode(targetcell) And targetcell.Row <= n
to
Do While Not Checkcode(targetcell) And targetcell.Row <= n

Be careful, there are two Do while loop in my code, so don't forget to
change the both.
i think that to change Macro name testzip to something else is convenient
for use.

keiji