View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.worksheet.functions
anand anand is offline
external usenet poster
 
Posts: 37
Default macro; reorganize blocks of data

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