View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Lars-Åke Aspelin[_2_] Lars-Åke Aspelin[_2_] is offline
external usenet poster
 
Posts: 913
Default macro; reorganize blocks of data

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