PDA

View Full Version : VBA code for re-organizing address lines



Uncel_Dolan
03-29-2016, 03:44 PM
Hey everyone,

I got the task to re-organize an address file. Here's what I want to do:

15772

I hope the blackout doesn't bother you. So I need the Name, StreetAddress, City and Zip to be reorganized and, most importantly, be in Rows adjacent to each other. Here's what I have so far:


Sub AddressBook()
For i = 1 To 2033 Step 4
Name = ActiveSheet.Range("A" & i).Value
Address = ActiveSheet.Range("A" & i + 1).Value
City = ActiveSheet.Range("A" & i + 2).Value
Zip = ActiveSheet.Range("B" & i + 2).Value


ActiveSheet.Range("D" & i).Value = Name
ActiveSheet.Range("E" & i).Value = Address
ActiveSheet.Range("F" & i).Value = City
ActiveSheet.Range("G" & i).Value = Zip
Next i
End Sub


This DOES grab all the data from Cloumn A, but I don't know how to arrange the data. The code, as is, just spills it out every fourth row.

I hope you can help me!

Thanks

Uncel_Dolan

Paul_Hossler
03-29-2016, 04:16 PM
Try something like this




Option Explicit

Sub AddressBook()
Dim iIn As Long, iOut As Long
Dim Name As String, Address As String, City As String, Zip As String

iOut = 1

For iIn = 1 To 2033 Step 4
Name = ActiveSheet.Range("A" & iIn).Value
Address = ActiveSheet.Range("A" & iIn + 1).Value
City = ActiveSheet.Range("A" & iIn + 2).Value
Zip = ActiveSheet.Range("B" & iIn + 2).Value


ActiveSheet.Range("D" & iOut).Value = Name
ActiveSheet.Range("E" & iOut).Value = Address
ActiveSheet.Range("F" & iOut).Value = City
ActiveSheet.Range("G" & iOut).Value = Zip

iOut = iOut + 1
Next iIn
End Sub

Uncel_Dolan
03-29-2016, 04:33 PM
Cool that works, thanks man!

SamT
03-29-2016, 04:55 PM
Edit: Just saw Paul's excellent post.

Deleted text

Unfortunately this leave you with a table that can only be sorted on first name, city and Zip,

Delete columns A:C

Insert a dozen columns between the Names Column (A) and the Street Column.

Sub SplitNames()
ActiveSheet.Range("A:A").TextToColumns(Space:=True)
End sub

This will fill various numbers of columns with parts of names
Two Columns:
SamT Tango

Three Columns:
SamT T. Tango = 2 first names
SamT Tom Tango = 2 first names
SamT Von Tango = 2 last names

Four Columns:
SamT T. Von Tango = 2 first & 2 last

Unless you have to do this for more than about 3 files, I would just edit the '2 last names' addresses manually leaving 3 or less filled cells
"SamT" & "Von Tango"
"SamT" & "T." & "Von Tango"

Then use code to combine the first two name columns ONLY if there were more than 2 columns with values.

Sub Combine2Names()
Dim Cel As Range

Set Cel = Range("A1")
Do While Cel <> ""
With Cel
If .Offset(, 2) <> "" Then
Cel = Cel & " " & .Offset(, 1)
.Offset(, 1) = .Offset(, 2)
.Offset(, 2) = ""
End If
End With
Set Cel = Cel.Offset(1)
Loop
End Sub