I put this up a few weeks ago. Got a response but not working right as I get
an error message "Argument not optional". Not sure anyone will recheck the
old post so I'm putting up again with the solution (which is not working).

Any new ideas or corrections appreciated. And thanks to person who gave
this a shot earlier.

On Sat, 12 Apr 2008 20:38:00 -0700, anand
wrote:

I have data on individuals in rows of data. Some patients require just one
row of data from A to AZ. Others require 2 or 3 lines of data always A to AZ.

Each block of data is separated by 1 empty row. There are over 2000 blocks
of data (whether just 1 row, 2 rows, or 3 rows each).

I need a way to reorganize the data. If there is just one row of data, no
change required.
If 2 lines of data, the 2nd line should be arrayed (moved) from the 2nd row
A to AZ to 1st row BA to CZ (next to the first row of data) ie. so all data
is now on one line.

If there are 3 rows of data, the 2nd row would be as above. 3rd row would
also move to 1st row but would go to DA to EZ i.e. all 3 rows of data on 1st
line.

Doesn't matter if there are irregular intervals between lines of data (i.e.
1st rows can stay in same position).

I'll be grateful for any assistance.

Thanks

anand


Try this:

Sub reorg_data(firstrow, lastrow, Optional blockwidth As Integer = 52)
Dim myrow As Integer
Dim mycol As Integer
Dim torow As Integer
Dim deletedrows As Integer
myrow = firstrow
With ActiveSheet
While myrow < lastrow - deletedrows
If .Cells(myrow, 1) < "" Then
mycol = 1
torow = myrow
While Cells(myrow + 1, 1) < ""
mycol = mycol + blockwidth
..Cells(myrow + 1, 1).Resize(1, blockwidth).Select
Selection.Cut
..Cells(torow, mycol).Select
..Paste
..Rows(myrow + 1).EntireRow.Delete shift:=xlUp
deletedrows = deletedrows + 1
Wend
End If
myrow = myrow + 1
Wend
..Cells(firstrow, 1).Select
End With
End Sub

Hope this helps / Lars-Ã…ke

Paste the following macro into a VBA module in your workbook. Make sure the
active sheet is the one you want to process with the macro, the run the macro
(Tools Macro Macros MoveData Run).

Sub MoveData()
Dim MT As Integer, BlockRows As Integer
Dim CurrRow As Long
Range("A1").Activate
CurrRow = ActiveCell.Row
MT = 0
BlockRows = 0
Do While MT < 20
If Len(ActiveCell.Value) 0 Then
MT = 0
BlockRows = BlockRows + 1
Select Case BlockRows
Case 2, 3
Range(Cells(CurrRow, 1), Cells(CurrRow, 52)).Select
Selection.Copy
Cells(CurrRow - BlockRows + 1, ((BlockRows - 1) * 52) +
1).Select
ActiveSheet.Paste
Cells(CurrRow, 1).EntireRow.Clear
Case Else
'do nothing
End Select
Else
MT = MT + 1
BlockRows = 0
End If
Cells(CurrRow + 1, 1).Activate
CurrRow = ActiveCell.Row
Loop
End Sub

If you are new to macros, this link to Jon Peltier's site may be helpful:
http://peltiertech.com/WordPress/200...e-elses-macro/

Hope this helps,

Hutch

"anand" wrote:

I put this up a few weeks ago. Got a response but not working right as I get
an error message "Argument not optional". Not sure anyone will recheck the
old post so I'm putting up again with the solution (which is not working).

Any new ideas or corrections appreciated. And thanks to person who gave
this a shot earlier.

On Sat, 12 Apr 2008 20:38:00 -0700, anand
wrote:

I have data on individuals in rows of data. Some patients require just one
row of data from A to AZ. Others require 2 or 3 lines of data always A to AZ.

Each block of data is separated by 1 empty row. There are over 2000 blocks
of data (whether just 1 row, 2 rows, or 3 rows each).

I need a way to reorganize the data. If there is just one row of data, no
change required.
If 2 lines of data, the 2nd line should be arrayed (moved) from the 2nd row
A to AZ to 1st row BA to CZ (next to the first row of data) ie. so all data
is now on one line.

If there are 3 rows of data, the 2nd row would be as above. 3rd row would
also move to 1st row but would go to DA to EZ i.e. all 3 rows of data on 1st
line.

Doesn't matter if there are irregular intervals between lines of data (i.e.
1st rows can stay in same position).

I'll be grateful for any assistance.

Thanks

anand


Try this:

Sub reorg_data(firstrow, lastrow, Optional blockwidth As Integer = 52)
Dim myrow As Integer
Dim mycol As Integer
Dim torow As Integer
Dim deletedrows As Integer
myrow = firstrow
With ActiveSheet
While myrow < lastrow - deletedrows
If .Cells(myrow, 1) < "" Then
mycol = 1
torow = myrow
While Cells(myrow + 1, 1) < ""
mycol = mycol + blockwidth
.Cells(myrow + 1, 1).Resize(1, blockwidth).Select
Selection.Cut
.Cells(torow, mycol).Select
.Paste
.Rows(myrow + 1).EntireRow.Delete shift:=xlUp
deletedrows = deletedrows + 1
Wend
End If
myrow = myrow + 1
Wend
.Cells(firstrow, 1).Select
End With
End Sub

Hope this helps / Lars-Ã…ke