transpose address information for each customer number

D

dan dungan

Hi,

I'm using excel 2000 and windows XP

I have 16219 rows of data in four columns:
Column A is a row number is added so I could return the data to the
proper order.
Column B is Customer number.
Column C is name or address or city, state and zip.
Column D is the Address type: 0= shipping, 1=bill to 1, 2 = bill to 2.
There could be more addresses for each customer--I'm not sure how many
there could be--I've seen at least 8 different addresses for a
customer number.


For example:

197 1007 ANIXTER XXXTACON INC. 1
198 2156123 NFFORDHUP STREET
199 *****990685***
200 CHATSWAY CA 91377
201 1007 PENTACOSTAL AEROSPACE GROUP 2
202 3017 HAWK WAY
203 *****CA990685*****
204 GRAND OIL TX 76662
205 1008 AMERICAN BUSLINES 0
206 MD 666
207 P.O. BOX 582839
208 OAKIE OK 74558
209 1008 AMERICAN BUSLINES INC. 1
210 ATTN SUPPLY SERVICES REC.
211 3800 N. DINGO ROAD
212 OAKIE OK 74558
213 USA

I would like to transpose the data from columns to rows keeping each
customer's information on one row. I don't need to transpose the row
number.

I would also like to put the city, state and zip in separate columns,
but I'll do that with the text to columns function later.

1007 ANIXTER XXXTACON INC. 1 2156123 NFFORDHUP STREET
*****990685*** CHATSWAY CA 91377
1007 PENTACOSTAL AEROSPACE GROUP 2 3017 HAWK WAY *****CA990685*****
GRAND OIL TX 76662
1008 AMERICAN BUSLINES 0 MD 666 P.O. BOX 582839 OAKIE OK 74558
1008 AMERICAN BUSLINES INC. 1 ATTN SUPPLY SERVICES REC. 3800 N.
DINGO ROAD OAKIE OK 74558
USA

I have not been able to get anything to come close.

Thanks for any assistance.

Dan
 
J

JP

Hey Dan,

If you knew that the addresses were all 4 rows high, this would work.
Or, if you could scrub the addresses so each one was exactly 4 rows
high.


Sub SplitAndTranspose()
'
' this procedure will split columnar data into areas and then
transpose them to a new sheet!!!
' be sure to sort first
'
'
Dim r As Long
Dim rng As Excel.Range
Dim RangeName As Name
Dim rRng As Excel.Range
Dim AreasCount As Long

Application.ScreenUpdating = False
Set rng = ActiveSheet.UsedRange.Rows
Col = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column

For r = rng.Rows.count - 3 To 4 Step -4
Cells(r, Col).EntireRow.Insert
Next r

Application.StatusBar = False
ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants, 23).Select
AreasCount = Selection.Areas.count
For i = 1 To AreasCount
Application.StatusBar = "Now processing area " & i & " of " &
AreasCount
If i > 1 Then
ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants,
23).Select
End If

' name each area so we can go back later
Selection.Areas(i).Select
Selection.Name = "Area" & i
Next i
b = Worksheets(1).Name
Set A = Worksheets.Add
A.Name = "Sheet2"
Worksheets(1).Move After:=Sheets(2)
Worksheets(1).Select

For Each RangeName In Names
Set rRng = Range(RangeName.Name)
rRng.Copy
Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1,
0).PasteSpecial Transpose:=True
Next RangeName


Set A = Nothing
Set rng = Nothing
Set rRng = Nothing
Application.StatusBar = False
End Sub


HTH,
JP
 
D

dan dungan

Hi JP,

Thanks for your response.

I was unable to scrub the file down to 4 rows per record. I just used
auto filter.

Thanks again,

Dan
 
Top