View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Beto[_3_] Beto[_3_] is offline
external usenet poster
 
Posts: 140
Default Macro for Multiple Sorts

Beto wrote:

Hi, this code works as long as all the columns has at least one data.


I added the error-handling and fixed a small problem.. I wasn't ordering
the last column.

Sub Ordena()
Dim RangeToSort As Range
Dim NewStCell As Range
Dim MyColumn As Integer

MyColumn = 2

Set RangeToSort = Range(Cells(1, 1), Cells(1, 1).End(xlDown)) _
.Range("A1:G8")

RangeToSort.Sort Key1:=Range("B" & MyColumn), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

On Error Resume Next
For MyColumn = 2 To 6
If Cells(1, MyColumn).End(xlDown).Offset(1, 0) = "" Then
Set NewStCell = Cells(1, MyColumn).End(xlDown). _
Offset(1, -MyColumn + 1)
Else
Set NewStCell = Cells(1, MyColumn).End(xlDown). _
End(xlDown).Offset(1, -MyColumn + 1)
End If

Set RangeToSort = Range(NewStCell, _
Cells(NewStCell.End(xlDown).Row, 7))

RangeToSort.Sort Key1:=Cells(1, MyColumn + 1), _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Next MyColumn
On Error GoTo 0
End Sub

Regards,
--
Beto
Reply: Erase between the dot (inclusive) and the @.
Responder: Borra la frase obvia y el punto previo.