Sorting multiple rows...

  • Thread starter Thread starter Treadstone
  • Start date Start date
T

Treadstone

How can i sort multiple rows from left to right where typically there are
about 50 columns but only maybe 5 or 6 cells in each row have the data that i
want to line up beside each other i have done it before but had to do it
manually a row at a time and there are over 900 rows.?
 
I have several columns to the right of a column with names many empty and
some with dates trying to sort all of these dates in order from left to right
all next to each other so i can have a smaller spreadsheet for easy reference
-- with no gaps (eg column A has the name column B has the first date column
C the second date and so on.
Thus rendering the cells with no data to the right of the final date and
making the spreadsheet to about 6 or 7 columns instead of the usual 50 where
the original information is taken from
 
Try this:

========
Option Explicit

Sub Macro3()
'
' Macro3 Macro
' Macro recorded 11/4/2009 by
'

'
ActiveSheet.Previous.Select
Columns("N:N").Select
Selection.Find(What:="ddd3", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End Sub
Sub DateSorting()
'JBeaucaire (11/4/2009)
Dim LC As Long, LR As Long, i As Long, MyArr
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row
LC = Range("A1").SpecialCells(xlCellTypeLastCell).Column


For i = 1 To LR
Range("B" & i, Cells(i, LC)).Copy
Cells(1, LC + 2).PasteSpecial xlPasteAll, skipblanks:=True,
Transpose:=True
Range("B" & i, Cells(i, LC)).ClearContents
Columns(LC + 2).Sort Key1:=Cells(1, LC + 2), Order1:=xlAscending,
Header:=xlNo
LR = Cells(Rows.Count, LC + 2).End(xlUp).Row
Range(Cells(1, LC + 2), Cells(LR, LC + 2)).Copy
Range("B" & i).PasteSpecial xlPasteAll, Transpose:=True
Columns(LC + 2).ClearContents
Next i

Application.ScreenUpdating = True
End Sub
==========

Does that work for you?
 
Sorry, copied in too much:

======
Option Explicit

Sub DateSorting()
'JBeaucaire (11/4/2009)
Dim LC As Long, LR As Long, i As Long, MyArr
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row
LC = Range("A1").SpecialCells(xlCellTypeLastCell).Column


For i = 1 To LR
Range("B" & i, Cells(i, LC)).Copy
Cells(1, LC + 2).PasteSpecial xlPasteAll, skipblanks:=True,
Transpose:=True
Range("B" & i, Cells(i, LC)).ClearContents
Columns(LC + 2).Sort Key1:=Cells(1, LC + 2), Order1:=xlAscending,
Header:=xlNo
LR = Cells(Rows.Count, LC + 2).End(xlUp).Row
Range(Cells(1, LC + 2), Cells(LR, LC + 2)).Copy
Range("B" & i).PasteSpecial xlPasteAll, Transpose:=True
Columns(LC + 2).ClearContents
Next i

Application.ScreenUpdating = True
End Sub
==========
 
Back
Top