Sort and Transpose

[wutzke]

I can do this with in the worksheet, but i'd like to do the same with
in VB


Starting with date and numberic values in separate cells in multiple
rows
2/2/2008 1 11/1/2007 12 7/1/2007 1 4/1/2007 2
1/1/08 10 10/1/2007 4 6/1/2007 5 3/1/2007 2
12/1/2007 3 9/1/2007 7


convert above into column
2/2/2008 1
1/1/08 10
12/1/2007 3
11/1/2007 12
10/1/2007 4
9/1/2007 7
7/1/2007 1
6/1/2007 5
4/1/2007 2
3/1/2007 2


sort columns
3/1/2007 2
4/1/2007 2
6/1/2007 5
7/1/2007 1
9/1/2007 7
10/1/2007 4
11/1/2007 12
12/1/2007 3
1/1/08 10
2/2/2008 1


convert above into row, each value in a separate column
2/2/2008 1 1/1/08 10 12/1/2007 3 11/1/2007 12 10/1/2007 4 9/1/2007 7
7/1/2007 1 6/1/2007 5 4/1/2007 2 3/1/2007

 

[Per Jessen]

Hi

I think this is what you are looking for with data in A1 and further.

Dim MyAray()
Dim Counter As Long

Sub ReArrangeData()
Range("A1").CurrentRegion.Select
CellCount = Selection.Rows.Count * Selection.Columns.Count
ReDim MyAray(CellCount + 2)
Counter = 0
For Each c In Selection
MyAray(Counter) = c.Value
Counter = Counter + 1
Next
Selection.Delete
For c = 0 To Counter Step 2
Range("A1").Offset(Off, 0) = MyAray(c)
Range("A1").Offset(Off, 1) = MyAray(c + 1)
Off = Off + 1
Next
Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlDescending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").CurrentRegion.Select
Off = 0
For Each c In Selection
c.Cut
Range("A1").Offset(0, Off).Select
ActiveSheet.Paste
Off = Off + 1
Next
End Sub

Regards,

Per