moving cells

B

bryan

I have a spreadsheet with 1500 entries in one column A. Each entry consist
of 4 lines of data and a space. I need to move the 2nd, 3rd and 4th lines to
columns b,c,d. and to delete the space between entries.

example:

John Doe
1234 lost street
Chicago, IL 60055
555-555-1212

Jane Doe
4321 Lost Street
Chicago, IL 60055
555-555-1212

changed to:

John Doe 1234 lost street Chicago, IL 60055 555-555-1212
Jane Doe 4321 lost street Chicago, IL 60055 555-555-1212
 
T

Tom Ogilvy

Sub RearrangeData()
Dim rng As Range, ar As Range
Dim cell As Range, i As Long
Set rng = Columns(1).SpecialCells(xlConstants)
For Each ar In rng.Areas
i = 1
For Each cell In ar
If i <> 1 Then
cell.Offset(-(i - 1), i - 1).Value = cell.Value
cell.ClearContents
End If
i = i + 1
Next cell
Next ar
Columns(1).SpecialCells(xlBlanks).EntireRow.Delete
End Sub
 
B

bryan

and what do I do with this jumble

Tom Ogilvy said:
Sub RearrangeData()
Dim rng As Range, ar As Range
Dim cell As Range, i As Long
Set rng = Columns(1).SpecialCells(xlConstants)
For Each ar In rng.Areas
i = 1
For Each cell In ar
If i <> 1 Then
cell.Offset(-(i - 1), i - 1).Value = cell.Value
cell.ClearContents
End If
i = i + 1
Next cell
Next ar
Columns(1).SpecialCells(xlBlanks).EntireRow.Delete
End Sub
 
W

William

Hi Bryan

Assuming there is no column A heading, try....

Sub Test()
Application.ScreenUpdating = False
With ActiveSheet
..Range("1:3").Insert Shift:=xlDown
..Range(.Range("A2"), .Range("A2").End(xlDown).Offset(-1, 0)).Delete
Shift:=xlUp
..Range("A:A").Copy .Range("B1:D1")
..Range("B1,C1:C2,D1:D3").Delete Shift:=xlUp
..Range("A:A").SpecialCells(xlCellTypeConstants, 23).Offset(1,
0).EntireRow.Delete
..Range("1:1").ClearContents
End With
Application.ScreenUpdating = True
End Sub

--

Regards

William

XL2003

(e-mail address removed)


|I have a spreadsheet with 1500 entries in one column A. Each entry consist
| of 4 lines of data and a space. I need to move the 2nd, 3rd and 4th lines
to
| columns b,c,d. and to delete the space between entries.
|
| example:
|
| John Doe
| 1234 lost street
| Chicago, IL 60055
| 555-555-1212
|
| Jane Doe
| 4321 Lost Street
| Chicago, IL 60055
| 555-555-1212
|
| changed to:
|
| John Doe 1234 lost street Chicago, IL 60055 555-555-1212
| Jane Doe 4321 lost street Chicago, IL 60055 555-555-1212
 
G

Gary Keramidas

right click the sheet tab and choose view code. if you don't see a code window,
double click the sheet name on the left under project
paste the code in the code window

then tools/macro/macros or ALT-8

and run the macro
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top