How do I convert a single column of addresses into rows for export

B

Benjy S

I have a list of addresses that are all in column A that I need to transform
into rows to export into ACT.

I am a total newbie to macros and VB.

The addresses are all seperated by a cell with the number 100. An example
of the list follows. There are about 350 addresses.

100
Realtor
Sherry Abell
Realty One Medina
3565 Medina Rd
Medina OH 44256
877 7233211
(e-mail address removed)
8777233211
100
Realtor
Nancy Adams
Kovack Realty Inc - Wadsworth
Ste 105 1392 High Street
Wadsworth OH 44281
800 8378883
(e-mail address removed)
100
Realtor
Terry Albright
Smucker Realty
6605 Smucker Dr.
Westfield Center OH 44251
330 8875286
100
Realtor
Mary Anderson
Realty One Medina
3565 Medina Rd
Medina OH 44256
877 7233211
(e-mail address removed)
8882010910

Thanks!
 
D

Dave Peterson

It's usually pretty difficult to parse this kind of stuff into the correct
columns.

I tried to dump the numeric entries (phone number???) to column A.
The email address to column B
the address with zip code to column C

You can rearrange those columns when you're cleaning the data.

ps. If you have multiple phone numbers in any group (or multiple email accounts
in any group), then only the last will be kept.

Option Explicit
Sub testme()
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim oRow As Long
Dim oCol As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim myVal As Variant

Set CurWks = ActiveSheet
Set NewWks = Worksheets.Add

oRow = 1
With CurWks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow
myVal = .Cells(iRow, "A").Value
If myVal = 100 Then
oRow = oRow + 1
oCol = 4
ElseIf IsNumeric(Application.Substitute(myVal, " ", "")) Then
'phone number
oCol = 1
ElseIf LCase(myVal) Like "*@*" Then
'email address
oCol = 2
ElseIf IsNumeric(Trim(Right(myVal, 5))) Then
'zip code??
oCol = 3
Else
oCol = oCol + 1
End If
NewWks.Cells(oRow, oCol).Value = .Cells(iRow, "A").Value
Next iRow
End With
End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 
B

Benjy S

Thank you so much ! That was a life saver!

Dave Peterson said:
It's usually pretty difficult to parse this kind of stuff into the correct
columns.

I tried to dump the numeric entries (phone number???) to column A.
The email address to column B
the address with zip code to column C

You can rearrange those columns when you're cleaning the data.

ps. If you have multiple phone numbers in any group (or multiple email accounts
in any group), then only the last will be kept.

Option Explicit
Sub testme()
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim oRow As Long
Dim oCol As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim myVal As Variant

Set CurWks = ActiveSheet
Set NewWks = Worksheets.Add

oRow = 1
With CurWks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow
myVal = .Cells(iRow, "A").Value
If myVal = 100 Then
oRow = oRow + 1
oCol = 4
ElseIf IsNumeric(Application.Substitute(myVal, " ", "")) Then
'phone number
oCol = 1
ElseIf LCase(myVal) Like "*@*" Then
'email address
oCol = 2
ElseIf IsNumeric(Trim(Right(myVal, 5))) Then
'zip code??
oCol = 3
Else
oCol = oCol + 1
End If
NewWks.Cells(oRow, oCol).Value = .Cells(iRow, "A").Value
Next iRow
End With
End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
Click to expand...
 
Top