ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Macro for Multiple Sorts (https://www.excelbanter.com/excel-programming/290123-macro-multiple-sorts.html)

dakota

Macro for Multiple Sorts
 
Using Excel 2000.
We have hundreds of rows of data that look like this:
A B C D E F G
1 Descr 1 hr 2 hrs 3 hrs 4 hrs 5 hrs 6 hrs
2 da 62
3 rf 24
4 aa 6
5 fr 5
6 cd 4
7 as 55
8 xx 14

The workbook has data in every row under column A
and one entry in one column (B-G) for each row.

We want to get a macro to perfrom multiple sorts on the
workbook so that it will look like this when finished:

A B C D E F G
1 Descr 1 hr 2 hrs 3 hrs 4 hrs 5 hrs 6 hrs
2 cd 4
3 fr 5
4 aa 6
5 as 55
6 da 62
7 xx 14
8 rf 24

We want to sort on column B. Then sort on the rest of the
worksheet on cloumn C. Then column D, E, and F.

We got the first part (the easy one) but can't figure out
how to get the macro to go to the next and succeeding
steps. After the first sort, I think that we need for the
macro to look for the first blank row under column B,
range select the rest of the worksheet and sort on C. Then
go to the first blank row under Column C, range select the
rest of the worksheet, and sort on Column D. Etc.

Range("A1").Select
Range(Selection, ActiveCell.SpecialCells
(xlLastCell)).Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

Can someone help us here, please?

R-Enemy

Macro for Multiple Sorts
 
Try this, I tried with your data and it worked.

Create a cell to hold how many elements in the column.
Example: B50's formula =CountA(B2:B49)
C50's formula =CountA(C2:C49)
D50's formula =CountA(D2:D49)

Sub SortColumns()
Dim i As Integer
Dim count As Integer
Dim ColumnCount As Integer

i = 2 'The sorting starts at row 2
ColumnCount = 3 'Number of columns to be sorted

For j = 1 To ColumnCount
count = Cells(50, j + 1).Value
Range(Cells(2, j + 1), Cells(49, j + 1)).sort Cells
(2, j + 1)
Range(Cells(2, j + 1), Cells(count + 2, j +
1)).Cut (Cells(i, j + 1))
i = i + count
Next j

End Sub



-----Original Message-----
Using Excel 2000.
We have hundreds of rows of data that look like this:
A B C D E F G
1 Descr 1 hr 2 hrs 3 hrs 4 hrs 5 hrs 6 hrs
2 da 62
3 rf 24
4 aa 6
5 fr 5
6 cd 4
7 as 55
8 xx 14

The workbook has data in every row under column A
and one entry in one column (B-G) for each row.

We want to get a macro to perfrom multiple sorts on the
workbook so that it will look like this when finished:

A B C D E F G
1 Descr 1 hr 2 hrs 3 hrs 4 hrs 5 hrs 6 hrs
2 cd 4
3 fr 5
4 aa 6
5 as 55
6 da 62
7 xx 14
8 rf 24

We want to sort on column B. Then sort on the rest of

the
worksheet on cloumn C. Then column D, E, and F.

We got the first part (the easy one) but can't figure out
how to get the macro to go to the next and succeeding
steps. After the first sort, I think that we need for the
macro to look for the first blank row under column B,
range select the rest of the worksheet and sort on C.

Then
go to the first blank row under Column C, range select

the
rest of the worksheet, and sort on Column D. Etc.

Range("A1").Select
Range(Selection, ActiveCell.SpecialCells
(xlLastCell)).Select
Selection.Sort Key1:=Range("B2"),

Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

Can someone help us here, please?
.


Beto[_3_]

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

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

For MyColumn = 2 To 5
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

End Sub

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


dakota

Macro for Multiple Sorts
 
Thanks a lot. I got it to work. I had to change the first
part where you had set the range to "A1:G8". The number of
rows could vary each time we run the macro. I also had to
take out the "DataOption1:=xlSortNormal" parts of the
routine - VB wouldn't let me compile the code with them
in. It did not seem to matter that I took them out. What
does the reference "On Error GoTo 0" do?

-----Original Message-----
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.

.


Beto[_3_]

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.


Beto[_3_]

Macro for Multiple Sorts
 
Dakota wrote:
Thanks a lot. I got it to work. I had to change the first
part where you had set the range to "A1:G8". The number of
rows could vary each time we run the macro. I also had to
take out the "DataOption1:=xlSortNormal" parts of the
routine - VB wouldn't let me compile the code with them
in. It did not seem to matter that I took them out. What
does the reference "On Error GoTo 0" do?


Hi, "On Error GoTo 0" returns normality to the error-handling, because
with "On Error Resume Next" I said: "If you find an error, it doesn't
matter, just go on".

Now if the column number changes, you'll also need to change the For
loop acoordingly.

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



All times are GMT +1. The time now is 10:38 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com