contact data in column to rows
Hello, I have a fairly huge excel file in this format:
1 Bob Smith 2 123 fair lane 3 toledo, oh 12345-1234 4 Phone: (123) 456-4567 5 Fax: (123) 456-2345 6 7 8 Bob Smith 9 123 fair lane 10 toledo, oh 12345-1234 11 Phone: (123) 456-4567 12 13 Bob Smith 14 VP of nothing 15 123 fair lane 16 toledo, oh 12345-1234 17 Phone: (123) 456-4567 and on and on. what I need is a macro that: starts at A1 selects the range A1:A6 (whatever it's size) copies it moves to B1 paste:transpose deletes rows 2-7 and runs again... I'm stumped I've seen some offset stuff, but the selection fo the range baffles me. some data is only 4 rows some is 12 rows. I can handle moving the data into the appropriate columns after this step is done, unless someone has an idea of putting phone and fax into appropriate columns (because they always begin with phone or fax), or @ symbol for e-mail or , & - for city state zip. any help would be appreciated. |
contact data in column to rows
Mike
This does not work as well as I would like but is reasonable. Make sure that there is a blank row above the addresses. Select them and run the code. Sub Transpose() Dim c Dim i As Integer, j As Integer, nr As Integer, count As Integer Dim rng As Range 'place values on rows Set rng = Selection nr = rng.Rows.count For Each c In rng c.Select If IsEmpty(c) Then j = 0: i = 0 ElseIf IsEmpty(c) = False Then j = j + 1: i = i - 1 ActiveCell.Offset(i, j).Value = c.Value End If Next c 'delete column A Columns("A:A").Select Selection.Delete shift:=xlToLeft 'Get rid or redundant rows For i = 2 To nr Cells(i, 1).Select If IsEmpty(ActiveCell) Then Selection.EntireRow.Delete i = i - 1 count = count + 1 If count = 10 Then Exit Sub End If End If Next i End Sub regards Peter -----Original Message----- Hello, I have a fairly huge excel file in this format: 1 Bob Smith 2 123 fair lane 3 toledo, oh 12345-1234 4 Phone: (123) 456-4567 5 Fax: (123) 456-2345 6 7 8 Bob Smith 9 123 fair lane 10 toledo, oh 12345-1234 11 Phone: (123) 456-4567 12 13 Bob Smith 14 VP of nothing 15 123 fair lane 16 toledo, oh 12345-1234 17 Phone: (123) 456-4567 and on and on. what I need is a macro that: starts at A1 selects the range A1:A6 (whatever it's size) copies it moves to B1 paste:transpose deletes rows 2-7 and runs again... I'm stumped I've seen some offset stuff, but the selection fo the range baffles me. some data is only 4 rows some is 12 rows. I can handle moving the data into the appropriate columns after this step is done, unless someone has an idea of putting phone and fax into appropriate columns (because they always begin with phone or fax), or @ symbol for e-mail or , & - for city state zip. any help would be appreciated. . |
contact data in column to rows
Mike,
copy a part of the data to a new worksheet and run this macro to see the outcome HTH Cecil Sub Macro1() Application.ScreenUpdating = False LR = Range("A" & Rows.Count).End(xlUp).Row For i = 1 To LR + 1 If Range("A" & i).Value = 0 Then y = Range("A" & i).Row - x x = Range("A" & i).Row End If If z < y Then z = y Next i x = LR For i = LR To 1 Step -1 If Range("A" & i).Value = 0 Then y = x - Range("A" & i).Row b = b + 1 If b 1 Then For j = y To z Range("A" & x).EntireRow.Insert (xlDown) Next j End If x = Range("A" & i).Row End If Next i y = x For j = y To z Range("A" & x).EntireRow.Insert (xlDown) Next j z = z + 1 LR = Range("A" & Rows.Count).End(xlUp).Row Range("A1:A" & LR).Select Selection.Find(What:="@", After:=ActiveCell, _ LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate x = ActiveCell.Row Do Until y = x Selection.FindNext(After:=ActiveCell).Activate y = ActiveCell.Row Cells((Int(ActiveCell.Row / z)) * z + 1, z).Value _ = ActiveCell.Value ActiveCell.Clear Loop Range("A1:A" & LR).Select Selection.Find(What:="Fax", After:=ActiveCell, _ LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate x = ActiveCell.Row Do Until y = x Selection.FindNext(After:=ActiveCell).Activate y = ActiveCell.Row Cells((Int(ActiveCell.Row / z)) * z + 1, z - 1).Value _ = ActiveCell.Value ActiveCell.Clear Loop Range("A1:A" & LR).Select Selection.Find(What:="Phone", After:=ActiveCell, _ LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate x = ActiveCell.Row Do Until y = x Selection.FindNext(After:=ActiveCell).Activate y = ActiveCell.Row Cells((Int(ActiveCell.Row / z)) * z + 1, z - 2).Value _ = ActiveCell.Value ActiveCell.Clear Loop Range("A1:A" & LR).Select Selection.Find(What:="-", After:=ActiveCell, _ LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate x = ActiveCell.Row Do Until y = x Selection.FindNext(After:=ActiveCell).Activate y = ActiveCell.Row Cells((Int(ActiveCell.Row / z)) * z + 1, z - 3).Value _ = ActiveCell.Value ActiveCell.Clear Loop For i = 0 To Int(LR / z) x = i * z + 1 Range(Cells(x + 1, 1), Cells(x + (z - 5), 1)).Select Selection.Copy Range("B" & x).Select Selection.PasteSpecial Paste:=xlPasteAll, _ Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Application.CutCopyMode = False Range(Cells(x + 1, 1), Cells(x + (z - 5), 1)).Clear Next i Range("A1:A" & LR).Select Selection.SpecialCells(xlCellTypeBlanks).EntireRow .Delete Range("A1").Select Application.ScreenUpdating = True End Sub "Mike" wrote in message om... Hello, I have a fairly huge excel file in this format: 1 Bob Smith 2 123 fair lane 3 toledo, oh 12345-1234 4 Phone: (123) 456-4567 5 Fax: (123) 456-2345 6 7 8 Bob Smith 9 123 fair lane 10 toledo, oh 12345-1234 11 Phone: (123) 456-4567 12 13 Bob Smith 14 VP of nothing 15 123 fair lane 16 toledo, oh 12345-1234 17 Phone: (123) 456-4567 and on and on. what I need is a macro that: starts at A1 selects the range A1:A6 (whatever it's size) copies it moves to B1 paste:transpose deletes rows 2-7 and runs again... I'm stumped I've seen some offset stuff, but the selection fo the range baffles me. some data is only 4 rows some is 12 rows. I can handle moving the data into the appropriate columns after this step is done, unless someone has an idea of putting phone and fax into appropriate columns (because they always begin with phone or fax), or @ symbol for e-mail or , & - for city state zip. any help would be appreciated. |
contact data in column to rows
Mike
I tested my previous effort with more data and it was rubish. This is the amended macro tested on 100 lines of data. I suggest that you enter Headings (Customer, Address etc) in columns B to F two rows above the the first record. Select the racords and run the macro. I got an error running Cecilkumaara's programm. Regards Peter -----Original Message----- Hello, I have a fairly huge excel file in this format: 1 Bob Smith 2 123 fair lane 3 toledo, oh 12345-1234 4 Phone: (123) 456-4567 5 Fax: (123) 456-2345 6 7 8 Bob Smith 9 123 fair lane 10 toledo, oh 12345-1234 11 Phone: (123) 456-4567 12 13 Bob Smith 14 VP of nothing 15 123 fair lane 16 toledo, oh 12345-1234 17 Phone: (123) 456-4567 and on and on. what I need is a macro that: starts at A1 selects the range A1:A6 (whatever it's size) copies it moves to B1 paste:transpose deletes rows 2-7 and runs again... I'm stumped I've seen some offset stuff, but the selection fo the range baffles me. some data is only 4 rows some is 12 rows. I can handle moving the data into the appropriate columns after this step is done, unless someone has an idea of putting phone and fax into appropriate columns (because they always begin with phone or fax), or @ symbol for e-mail or , & - for city state zip. any help would be appreciated. . |
All times are GMT +1. The time now is 08:56 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com