sort in excel 2007

[Marco]

I use this (fOrderMany() ) for sort number in excel 2003 and it works well.
Now i try in in excel 2007 and it doesen't work. Why?
In worksheet there are some emply cell.
Sort cell in groups of 7 by row C2 AK2, C3 AK3...
C2 I2, J2 P2, Q2 W2, X2 AD2,
AE2 AK2

Sub OrderMany()
Dim Rng As Range
Dim iLastRow As Long
Dim i As Long, j As Long
iLastRow = Cells(Rows.Count, "C").End(xlUp).Row
For i = 2 To iLastRow
For j = 3 To 31 Step 7
Range(Cells(i, j), Cells(i, j).Offset(0, 6)).Sort _
Key1:=Range(Cells(i, j), Cells(i, j).Offset(0, 6)), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlLeftToRight, _
DataOption1:=xlSortNormal
Next j
Next i
End Sub

thx

 

[Jim Cone]

"Doesen't work" is not very informative is it?
In any case, calling the sub fOrderMany will not call the sub OrderMany.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Marco" <[email protected]>
wrote in message
I use this (fOrderMany() ) for sort number in excel 2003 and it works well.
Now i try in in excel 2007 and it doesen't work. Why?
In worksheet there are some emply cell.
Sort cell in groups of 7 by row C2 AK2, C3 AK3...
C2 I2, J2 P2, Q2 W2, X2 AD2,
AE2 AK2

Sub OrderMany()
Dim Rng As Range
Dim iLastRow As Long
Dim i As Long, j As Long
iLastRow = Cells(Rows.Count, "C").End(xlUp).Row
For i = 2 To iLastRow
For j = 3 To 31 Step 7
Range(Cells(i, j), Cells(i, j).Offset(0, 6)).Sort _
Key1:=Range(Cells(i, j), Cells(i, j).Offset(0, 6)), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlLeftToRight, _
DataOption1:=xlSortNormal
Next j
Next i
End Sub

thx

 

[Marco]

"Doesen't work" is not very informative is it?

it seems that beginnings the ordering but does not end. usually it employs 2
minute but after 5 it is still ordering and I must close it with task
manager , nothing is saved and ordered .

Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware

thx

 

[Jim Cone]

Check the value of iLastRow.
If that value is very large your code would take a long time to complete.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"Marco" <[email protected]>
wrote in message

"Doesen't work" is not very informative is it?

it seems that beginnings the ordering but does not end. usually it employs 2
minute but after 5 it is still ordering and I must close it with task
manager , nothing is saved and ordered .

thx

 

[Marco]

Check the value of iLastRow.
If that value is very large your code would take a long time to complete.

No, the value o iLastRow are the same in excel 2003 and excel 2007. the file
is the same too.
thx

Ps i copy the code from guide
Sub fOrderMany()

Dim Rng As Range
Dim iLastRow As Long
Dim i As Long, j As Long
iLastRow = Cells(Rows.Count, "C").End(xlUp).Row
For i = 2 To iLastRow
For j = 3 To 31 Step 7

With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
.SortFields.Clear
.SortFields.Add Key:=Range(Cells(i, j), Cells(i, j).Offset(0, 6)), _
SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
.SetRange Range(Cells(i, j), Cells(i, j).Offset(0, 6))
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Next j
Next i

MsgBox "Sort complete.", vbInformation

End Sub
This works, but it cannot be used because pass on screen every group of
cells for row. it needs half a day...

 

[Jim Cone]

I qualified all cell/range references with the workbook/sheet.
This is good practice and something that appears to be a
requirement with xl2007.
Note: you must enter the correct sheet name where indicated.
'---------------------
Sub OrderMany()
Dim objSheet As Excel.Worksheet
Dim iLastRow As Long
Dim i As Long
Dim j As Long

Set objSheet = ThisWorkbook.Worksheets("Enter_Name") '<<< CORRECT
iLastRow = objSheet.Cells(objSheet.Rows.Count, "C").End(xlUp).Row

For i = 2 To iLastRow
For j = 3 To 31 Step 7
objSheet.Range(objSheet.Cells(i, j), objSheet.Cells(i, j).Offset(0, 6)).Sort _
Key1:=objSheet.Range(objSheet.Cells(i, j), _
objSheet.Cells(i, j).Offset(0, 6)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
Next j
Next i
End Sub
-----------
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"Marco" <[email protected]>
wrote in message

Check the value of iLastRow.
If that value is very large your code would take a long time to complete.

No, the value o iLastRow are the same in excel 2003 and excel 2007. the file
is the same too.
thx

Ps i copy the code from guide
Sub fOrderMany()

Dim Rng As Range
Dim iLastRow As Long
Dim i As Long, j As Long
iLastRow = Cells(Rows.Count, "C").End(xlUp).Row
For i = 2 To iLastRow
For j = 3 To 31 Step 7

With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
.SortFields.Clear
.SortFields.Add Key:=Range(Cells(i, j), Cells(i, j).Offset(0, 6)), _
SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
.SetRange Range(Cells(i, j), Cells(i, j).Offset(0, 6))
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Next j
Next i

MsgBox "Sort complete.", vbInformation

End Sub
This works, but it cannot be used because pass on screen every group of
cells for row. it needs half a day...

 

[Marco]

"Jim Cone" wrote

I qualified all cell/range references with the workbook/sheet.
This is good practice and something that appears to be a
requirement with xl2007.
Note: you must enter the correct sheet name where indicated.
'---------------------
Sub OrderMany()
Dim objSheet As Excel.Worksheet
Dim iLastRow As Long
Dim i As Long
Dim j As Long

Set objSheet = ThisWorkbook.Worksheets("Enter_Name") '<<< CORRECT
iLastRow = objSheet.Cells(objSheet.Rows.Count, "C").End(xlUp).Row

For i = 2 To iLastRow
For j = 3 To 31 Step 7
objSheet.Range(objSheet.Cells(i, j), objSheet.Cells(i, j).Offset(0,
6)).Sort _
Key1:=objSheet.Range(objSheet.Cells(i, j), _
objSheet.Cells(i, j).Offset(0, 6)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
Next j
Next i
End Sub
-----------

I am despair, your solotion works perfect in excel 2003 and it's fast, but
no in excel 2007. A t bottom of sheet there is a bar with order, it moves ,
a very beautiful effect but it does not happen nothing and the solution is
task manager.

Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware

thx

 

[Roger Govier]

Hi Marco

Let me begin by saying that whilst I have all version of XL from 97 to
2007, I have yet to write any code using XL2007, and as of yet I have
not run many of my applications in XL2007, which had been written in
earlier versions .

I'm not sure whether the following would have any bearing on your
problem, but I tried a simple experiment of recording the same macro in
both XL2003 and XL2007 using the macro recorder.

XL2003

Range("A1:C12").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

XL2007

Range("A1:C12").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add
Key:=Range("A1:A7"), _
SortOn:=xlSortOnValues, Order:=xlDescending,
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:C7")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


So XL2007 creates more code to carry out the same task.
It also seems intelligent enough to work out the used range within the
total range selected (there was only data in the first 7 of the 12
rows).

The Sort method xlPinYin (default method) is defined in help as
XlSortMethod Enumeration

Name Value Description
xlPinYin 1 Phonetic Chinese sort order for characters. This is the
default value.
xlStroke 2 Sort by the quantity of strokes in each character.

Maybe if you amended your code to adopt the same structure as the
macro-recorder, you might see a difference.

Just a thought.

 

[Marco]

"Roger Govier" wrote

Hi Marco

Hi Roger

I'm not sure whether the following would have any bearing on your problem,
but I tried a simple experiment of recording the same macro in both XL2003
and XL2007 using the macro recorder.

XL2003

Range("A1:C12").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

XL2007

Range("A1:C12").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add
Key:=Range("A1:A7"), _
SortOn:=xlSortOnValues, Order:=xlDescending,
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:C7")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

How can i adapt the code with new feature?, i am not expert... ????

this is a sample value data
76 87 58 38 26 42 83 22 64 88 44 78 66 68 45 42 17 27 51 21 34 77 79 89 75
86 55 81 9 15 27 43 62 31 13

When I say that the code over does not work, it is not exact if I try with
10 lines I work but if I try with 5000 rows in 2003 it puts 15 second with
2007 I have not never seen the end also after 10 minute. Can you try, copy
the values over for 5000 row is not important if the lines are equal .



Regards

Sub OrderMany()
Dim objSheet As Excel.Worksheet
Dim iLastRow As Long
Dim i As Long
Dim j As Long


Set objSheet = ActiveWorkbook.Worksheets(1)
iLastRow = objSheet.Cells(objSheet.Rows.Count, "C").End(xlUp).Row

For i = 2 To iLastRow
For j = 3 To 31 Step 7
objSheet.Range(objSheet.Cells(i, j), objSheet.Cells(i, j).Offset(0, 6)).Sort
_
Key1:=objSheet.Range(objSheet.Cells(i, j), _
objSheet.Cells(i, j).Offset(0, 6)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
Next j
Next i


MsgBox "Sort complete.", vbInformation



End Sub

 

[Roger Govier]

Hi Marco

Sorry for the delay in response - I have been busy with other things.

I ran your code in both XL2003 and XL2007 only on a sample of 1000
lines, those being a repeat of the 2 lines of data supplied.

Both ran to completion, and although I didn't time them I believe XL2007
was faster.

I wonder whether you have a lot of Conditional Formatting in your file.
I had none.
I have read that some people have experienced very slow response in
files in XL2007 when there is a lot of CF applied.

However, this time round I did take the time to read through what your
code was doing.
As you are looping through each row 5 times as you do your block of 7
column sorts left to right, with 5000 lines this is going to take a lot
of time.

I have added some code as below.
First I have numbered the rows as they are.
Then calculated the length of each row.
Sorted by row length
Looped through the groups of same length carrying out your 7 column sort
Sorted the whole range back in the original row order.

So rather than 1000 iterations x 5, my routine had 2 x 5.
Yours will be more than 2 x 5, as you will have more row lengths, but it
cannot be more than 38 x 5 as there are only 38 columns at most.

Anyway, it will be a minimum of 25 times faster and probably quite a lot
more.
I am sure there are more efficient ways of writing the code than I am
showing her, but it may help to get you running faster.

Sub OrderMany2()
Dim objSheet As Excel.Worksheet
Dim iLastRow As Long, iLastColumn As Long
Dim i As Long, c As Long
Dim j As Long
Dim begrange As Long, endrange As Long, endrange2 As Range

Set objSheet = ActiveWorkbook.Worksheets(1)
iLastRow = objSheet.Cells(objSheet.Rows.Count, "c").End(xlUp).Row

Cells.Select
Cells.Find(What:="*", AFTER:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
MatchCase:=False, SearchFormat:=False).Activate
iLastColumn = ActiveCell.Column
c = iLastColumn + 12

objSheet.Cells(2, c).FormulaR1C1 = "1"
objSheet.Cells(3, c).FormulaR1C1 = "2"
Range(Cells(2, c), Cells(3, c)).Select
Selection.AutoFill Destination:=Range(Cells(2, c), Cells(iLastRow,
c)), Type:=xlFillDefault
Cells(2, c + 1).FormulaR1C1 = "=COUNT(RC[-37]:RC[-13])"
Cells(2, c + 1).Select
Selection.AutoFill Destination:=Range(Cells(2, c + 1),
Cells(iLastRow, c + 1))
Cells(2, c + 2).FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],"""",RC[-1])"
Cells(2, c + 2).Select
Selection.AutoFill Destination:=Range(Cells(2, c + 2),
Cells(iLastRow, c + 2))
Cells(2, c + 3).FormulaR1C1 = "=COUNT(C[-1]) -1"

objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(2,
2).Offset(iLastRow, c)).Sort _
Key1:=objSheet.Range(objSheet.Cells(2, c + 1), _
objSheet.Cells(2, 2).Offset(iLastRow, c)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Cells(iLastRow, c + 2) = iLastRow
begrange = 0: endrange = 2:
Set endrange2 = Cells(2, c + 2)

For i = 1 To Cells(2, c + 3).Value
begrange = begrange + endrange - 1

With Range(Cells(2, c + 2), Cells(iLastRow, c + 2))
Set endrange2 = .Find(What:="*", AFTER:=endrange2, _
LookIn:=xlValues, LookAt:=xlWhole,
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
End With

endrange = endrange2.Row
endrange = endrange - begrange + 1

For j = 3 To 31 Step 7

objSheet.Range(objSheet.Cells(begrange, j), objSheet.Cells(begrange,
j).Offset(endrange, 6)).Select
objSheet.Range(objSheet.Cells(begrange, j), objSheet.Cells(begrange,
j).Offset(endrange, 6)).Sort _
Key1:=objSheet.Range(objSheet.Cells(begrange, j), _
objSheet.Cells(begrange, j).Offset(endrange, 6)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
Next j
Next i

objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(2,
2).Offset(iLastRow, c)).Sort _
Key1:=objSheet.Range(objSheet.Cells(2, c), _
objSheet.Cells(2, 2).Offset(iLastRow, c)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range(Cells(2, c), Cells(iLastRow, c + 4)).Clear
Cells(2, 3).Select

MsgBox "Sort complete.", vbInformation

End Sub

 

[Roger Govier]

Hi Marco

I left one line in the code that I was using to watch what was happening
as I stepped through the code.
If you remove it, it will go much quicker.
The line to remove is the first line in the j loop. There is no need to
select the range before performing the sort.

objSheet.Range(objSheet.Cells(begrange, j), objSheet.Cells(begrange,
j).Offset(endrange, 6)).Select

Also, watch out for linewrap in the code where the newsreader will have
broken lines.

--
Regards

Roger Govier

Hi Marco

Sorry for the delay in response - I have been busy with other things.

I ran your code in both XL2003 and XL2007 only on a sample of 1000
lines, those being a repeat of the 2 lines of data supplied.

Both ran to completion, and although I didn't time them I believe
XL2007 was faster.

I wonder whether you have a lot of Conditional Formatting in your
file. I had none.
I have read that some people have experienced very slow response in
files in XL2007 when there is a lot of CF applied.

However, this time round I did take the time to read through what your
code was doing.
As you are looping through each row 5 times as you do your block of 7
column sorts left to right, with 5000 lines this is going to take a
lot of time.

I have added some code as below.
First I have numbered the rows as they are.
Then calculated the length of each row.
Sorted by row length
Looped through the groups of same length carrying out your 7 column
sort
Sorted the whole range back in the original row order.

So rather than 1000 iterations x 5, my routine had 2 x 5.
Yours will be more than 2 x 5, as you will have more row lengths, but
it cannot be more than 38 x 5 as there are only 38 columns at most.

Anyway, it will be a minimum of 25 times faster and probably quite a
lot more.
I am sure there are more efficient ways of writing the code than I am
showing her, but it may help to get you running faster.

Sub OrderMany2()
Dim objSheet As Excel.Worksheet
Dim iLastRow As Long, iLastColumn As Long
Dim i As Long, c As Long
Dim j As Long
Dim begrange As Long, endrange As Long, endrange2 As Range

Set objSheet = ActiveWorkbook.Worksheets(1)
iLastRow = objSheet.Cells(objSheet.Rows.Count, "c").End(xlUp).Row

Cells.Select
Cells.Find(What:="*", AFTER:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious,
_
MatchCase:=False, SearchFormat:=False).Activate
iLastColumn = ActiveCell.Column
c = iLastColumn + 12

objSheet.Cells(2, c).FormulaR1C1 = "1"
objSheet.Cells(3, c).FormulaR1C1 = "2"
Range(Cells(2, c), Cells(3, c)).Select
Selection.AutoFill Destination:=Range(Cells(2, c), Cells(iLastRow,
c)), Type:=xlFillDefault
Cells(2, c + 1).FormulaR1C1 = "=COUNT(RC[-37]:RC[-13])"
Cells(2, c + 1).Select
Selection.AutoFill Destination:=Range(Cells(2, c + 1),
Cells(iLastRow, c + 1))
Cells(2, c + 2).FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],"""",RC[-1])"
Cells(2, c + 2).Select
Selection.AutoFill Destination:=Range(Cells(2, c + 2),
Cells(iLastRow, c + 2))
Cells(2, c + 3).FormulaR1C1 = "=COUNT(C[-1]) -1"

objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(2,
2).Offset(iLastRow, c)).Sort _
Key1:=objSheet.Range(objSheet.Cells(2, c + 1), _
objSheet.Cells(2, 2).Offset(iLastRow, c)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Cells(iLastRow, c + 2) = iLastRow
begrange = 0: endrange = 2:
Set endrange2 = Cells(2, c + 2)

For i = 1 To Cells(2, c + 3).Value
begrange = begrange + endrange - 1

With Range(Cells(2, c + 2), Cells(iLastRow, c + 2))
Set endrange2 = .Find(What:="*", AFTER:=endrange2, _
LookIn:=xlValues, LookAt:=xlWhole,
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
End With

endrange = endrange2.Row
endrange = endrange - begrange + 1

For j = 3 To 31 Step 7

objSheet.Range(objSheet.Cells(begrange, j), objSheet.Cells(begrange,
j).Offset(endrange, 6)).Select
objSheet.Range(objSheet.Cells(begrange, j), objSheet.Cells(begrange,
j).Offset(endrange, 6)).Sort _
Key1:=objSheet.Range(objSheet.Cells(begrange, j), _
objSheet.Cells(begrange, j).Offset(endrange, 6)), Order1:=xlAscending,
_
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
Next j
Next i

objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(2,
2).Offset(iLastRow, c)).Sort _
Key1:=objSheet.Range(objSheet.Cells(2, c), _
objSheet.Cells(2, 2).Offset(iLastRow, c)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range(Cells(2, c), Cells(iLastRow, c + 4)).Clear
Cells(2, 3).Select

MsgBox "Sort complete.", vbInformation

End Sub



--
Regards

Roger Govier

"Roger Govier" wrote


Hi Roger

How can i adapt the code with new feature?, i am not expert... ????

this is a sample value data
76 87 58 38 26 42 83 22 64 88 44 78 66 68 45 42 17 27 51 21 34 77 79
89 75 86 55 81 9 15 27 43 62 31 13

When I say that the code over does not work, it is not exact if I try
with 10 lines I work but if I try with 5000 rows in 2003 it puts 15
second with 2007 I have not never seen the end also after 10 minute.
Can you try, copy the values over for 5000 row is not important if
the lines are equal .



Regards

Sub OrderMany()
Dim objSheet As Excel.Worksheet
Dim iLastRow As Long
Dim i As Long
Dim j As Long


Set objSheet = ActiveWorkbook.Worksheets(1)
iLastRow = objSheet.Cells(objSheet.Rows.Count, "C").End(xlUp).Row

For i = 2 To iLastRow
For j = 3 To 31 Step 7
objSheet.Range(objSheet.Cells(i, j), objSheet.Cells(i, j).Offset(0,
6)).Sort _
Key1:=objSheet.Range(objSheet.Cells(i, j), _
objSheet.Cells(i, j).Offset(0, 6)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
Next j
Next i


MsgBox "Sort complete.", vbInformation



End Sub

 

[Marco]

"Roger Govier" wrote

Hi Marco

Hi Roger
Sure I have mistaken or lost something but don't work.

Sub OrderMany()
Dim objSheet As Excel.Worksheet
Dim iLastRow As Long, iLastColumn As Long
Dim i As Long, c As Long
Dim j As Long
Dim begrange As Long, endrange As Long, endrange2 As Range

Set objSheet = ActiveWorkbook.Worksheets(1)
iLastRow = objSheet.Cells(objSheet.Rows.Count, "c").End(xlUp).Row

Cells.Select
Cells.Find(What:="*", AFTER:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
MatchCase:=False, SearchFormat:=False).Activate
iLastColumn = ActiveCell.Column
c = iLastColumn + 12

objSheet.Cells(2, c).FormulaR1C1 = "1"
objSheet.Cells(3, c).FormulaR1C1 = "2"
Range(Cells(2, c), Cells(3, c)).Select
Selection.AutoFill Destination:=Range(Cells(2, c), Cells(iLastRow, c)),
Type:=xlFillDefault
Cells(2, c + 1).FormulaR1C1 = "=COUNT(RC[-37]:RC[-13])"
Cells(2, c + 1).Select
Selection.AutoFill Destination:=Range(Cells(2, c + 1), Cells(iLastRow, c
+ 1))
Cells(2, c + 2).FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],"""",RC[-1])"
Cells(2, c + 2).Select
Selection.AutoFill Destination:=Range(Cells(2, c + 2), Cells(iLastRow, c
+ 2))
Cells(2, c + 3).FormulaR1C1 = "=COUNT(C[-1]) -1"

objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(2, 2).Offset(iLastRow,
c)).Sort _
Key1:=objSheet.Range(objSheet.Cells(2, c + 1), _
objSheet.Cells(2, 2).Offset(iLastRow, c)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Cells(iLastRow, c + 2) = iLastRow
begrange = 0: endrange = 2:
Set endrange2 = Cells(2, c + 2)

For i = 1 To Cells(2, c + 3).Value
begrange = begrange + endrange - 1

With Range(Cells(2, c + 2), Cells(iLastRow, c + 2))
Set endrange2 = .Find(What:="*", AFTER:=endrange2, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns,
_
SearchDirection:=xlNext, MatchCase:=False)
End With

endrange = endrange2.Row
endrange = endrange - begrange + 1

For j = 3 To 31 Step 7

'with or without
******************************************************************
objSheet.Range(objSheet.Cells(begrange, j), objSheet.Cells(begrange,
j).Offset(endrange, 6)).Select
'*******************************************************************************
objSheet.Range(objSheet.Cells(begrange, j), objSheet.Cells(begrange,
j).Offset(endrange, 6)).Sort _
Key1:=objSheet.Range(objSheet.Cells(begrange, j), _
objSheet.Cells(begrange, j).Offset(endrange, 6)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
Next j
Next i

objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(2, 2).Offset(iLastRow,
c)).Sort _
Key1:=objSheet.Range(objSheet.Cells(2, c), _
objSheet.Cells(2, 2).Offset(iLastRow, c)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range(Cells(2, c), Cells(iLastRow, c + 4)).Clear
Cells(2, 3).Select

MsgBox "Sort complete.", vbInformation

End Sub

I tested with original access database and output excel file and standalone
excel file with only 1000 equal rows.
sample data
c2 ak2
c1000 ak1000
76 87 58 38 26 42 83 22 64 88 44 78 66 68 45 42 17 27 51 21 34 77 79 89 77
86 55 81 9 15 27 43 62 31 13
desire result
26 38 42 58 76 83 87 22 44 64 66 68 78 88 17 21 27 34 42 45 51 55 77 77 79
81 86 89 9 13 15 27 31 43 62

Regards

Roger Govier

Regards

 

[Roger Govier]

Hi Marco

It worked fine for me.Are you saying that the data was just one long row
of data that got wrapped by the newsreader, or is it 2 rows.
I took the sample that you sent originally as 2 rows one of length 25
and the second of length 10.
That's why I did the preliminary sort to get all the 10 length rows
together, followed by the 25 length rows then sorted the rows back to
their original order at the end

If all of your data is of length 35, there is no need to do the
preliminary sort nor the final sort.

If you want to email me direct with a files with your data, I will ad
the code and send it back to you.
To mail direct remove NOSPAM from my address.

--
Regards

Roger Govier

"Roger Govier" wrote

Hi Marco

Hi Roger
Sure I have mistaken or lost something but don't work.

Sub OrderMany()
Dim objSheet As Excel.Worksheet
Dim iLastRow As Long, iLastColumn As Long
Dim i As Long, c As Long
Dim j As Long
Dim begrange As Long, endrange As Long, endrange2 As Range

Set objSheet = ActiveWorkbook.Worksheets(1)
iLastRow = objSheet.Cells(objSheet.Rows.Count, "c").End(xlUp).Row

Cells.Select
Cells.Find(What:="*", AFTER:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious,
_
MatchCase:=False, SearchFormat:=False).Activate
iLastColumn = ActiveCell.Column
c = iLastColumn + 12

objSheet.Cells(2, c).FormulaR1C1 = "1"
objSheet.Cells(3, c).FormulaR1C1 = "2"
Range(Cells(2, c), Cells(3, c)).Select
Selection.AutoFill Destination:=Range(Cells(2, c), Cells(iLastRow,
c)), Type:=xlFillDefault
Cells(2, c + 1).FormulaR1C1 = "=COUNT(RC[-37]:RC[-13])"
Cells(2, c + 1).Select
Selection.AutoFill Destination:=Range(Cells(2, c + 1),
Cells(iLastRow, c + 1))
Cells(2, c + 2).FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],"""",RC[-1])"
Cells(2, c + 2).Select
Selection.AutoFill Destination:=Range(Cells(2, c + 2),
Cells(iLastRow, c + 2))
Cells(2, c + 3).FormulaR1C1 = "=COUNT(C[-1]) -1"

objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(2,
2).Offset(iLastRow, c)).Sort _
Key1:=objSheet.Range(objSheet.Cells(2, c + 1), _
objSheet.Cells(2, 2).Offset(iLastRow, c)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Cells(iLastRow, c + 2) = iLastRow
begrange = 0: endrange = 2:
Set endrange2 = Cells(2, c + 2)

For i = 1 To Cells(2, c + 3).Value
begrange = begrange + endrange - 1

With Range(Cells(2, c + 2), Cells(iLastRow, c + 2))
Set endrange2 = .Find(What:="*", AFTER:=endrange2, _
LookIn:=xlValues, LookAt:=xlWhole,
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
End With

endrange = endrange2.Row
endrange = endrange - begrange + 1

For j = 3 To 31 Step 7

'with or without
******************************************************************
objSheet.Range(objSheet.Cells(begrange, j), objSheet.Cells(begrange,
j).Offset(endrange, 6)).Select
'*******************************************************************************
objSheet.Range(objSheet.Cells(begrange, j), objSheet.Cells(begrange,
j).Offset(endrange, 6)).Sort _
Key1:=objSheet.Range(objSheet.Cells(begrange, j), _
objSheet.Cells(begrange, j).Offset(endrange, 6)), Order1:=xlAscending,
_
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
Next j
Next i

objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(2,
2).Offset(iLastRow, c)).Sort _
Key1:=objSheet.Range(objSheet.Cells(2, c), _
objSheet.Cells(2, 2).Offset(iLastRow, c)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range(Cells(2, c), Cells(iLastRow, c + 4)).Clear
Cells(2, 3).Select

MsgBox "Sort complete.", vbInformation

End Sub

I tested with original access database and output excel file and
standalone excel file with only 1000 equal rows.
sample data
c2 ak2
c1000 ak1000
76 87 58 38 26 42 83 22 64 88 44 78 66 68 45 42 17 27 51 21 34 77 79
89 77 86 55 81 9 15 27 43 62 31 13
desire result
26 38 42 58 76 83 87 22 44 64 66 68 78 88 17 21 27 34 42 45 51 55 77
77 79 81 86 89 9 13 15 27 31 43 62

Regards

Roger Govier

Regards

 

[Roger Govier]

Hi Marco

I have received your data with 7,700 rows and tested with it.

Let me start by saying I was talking rubbish originally. Sorting by row
length and then carrying out the Left to Right sort is nonsense. It
worked for me as I only had 2 rows repeated 500 times each.
It will only sort left to right based on the first of the rows in a
block, so there is no alternative to going through your iteration 5
times on each row in turn.

Under xL2003 it completed the sort in around 6 seconds (timed roughly
with a watch).
Under XL2007 it took 66 seconds.

I could not detect any difference in speed between using your original
Xl2003 code (modified by Jim Cone) and code created using the structure
as suggested by the XL2007 macro.

I did add lines to the code posted by Jim at the beginning and end as
follows
application.ScreenUpdating=False
application.calculation=xlmanual
setting them back to True and xlAutomatic at the end.

I have sent both the XL2007 and XL2003 files back to you directly.

--
Regards

Roger Govier

Hi Marco

It worked fine for me.Are you saying that the data was just one long
row of data that got wrapped by the newsreader, or is it 2 rows.
I took the sample that you sent originally as 2 rows one of length 25
and the second of length 10.
That's why I did the preliminary sort to get all the 10 length rows
together, followed by the 25 length rows then sorted the rows back to
their original order at the end

If all of your data is of length 35, there is no need to do the
preliminary sort nor the final sort.

If you want to email me direct with a files with your data, I will ad
the code and send it back to you.
To mail direct remove NOSPAM from my address.

--
Regards

Roger Govier

"Roger Govier" wrote

Hi Marco

Hi Roger
Sure I have mistaken or lost something but don't work.

Sub OrderMany()
Dim objSheet As Excel.Worksheet
Dim iLastRow As Long, iLastColumn As Long
Dim i As Long, c As Long
Dim j As Long
Dim begrange As Long, endrange As Long, endrange2 As Range

Set objSheet = ActiveWorkbook.Worksheets(1)
iLastRow = objSheet.Cells(objSheet.Rows.Count, "c").End(xlUp).Row

Cells.Select
Cells.Find(What:="*", AFTER:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious,
_
MatchCase:=False, SearchFormat:=False).Activate
iLastColumn = ActiveCell.Column
c = iLastColumn + 12

objSheet.Cells(2, c).FormulaR1C1 = "1"
objSheet.Cells(3, c).FormulaR1C1 = "2"
Range(Cells(2, c), Cells(3, c)).Select
Selection.AutoFill Destination:=Range(Cells(2, c), Cells(iLastRow,
c)), Type:=xlFillDefault
Cells(2, c + 1).FormulaR1C1 = "=COUNT(RC[-37]:RC[-13])"
Cells(2, c + 1).Select
Selection.AutoFill Destination:=Range(Cells(2, c + 1),
Cells(iLastRow, c + 1))
Cells(2, c + 2).FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],"""",RC[-1])"
Cells(2, c + 2).Select
Selection.AutoFill Destination:=Range(Cells(2, c + 2),
Cells(iLastRow, c + 2))
Cells(2, c + 3).FormulaR1C1 = "=COUNT(C[-1]) -1"

objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(2,
2).Offset(iLastRow, c)).Sort _
Key1:=objSheet.Range(objSheet.Cells(2, c + 1), _
objSheet.Cells(2, 2).Offset(iLastRow, c)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Cells(iLastRow, c + 2) = iLastRow
begrange = 0: endrange = 2:
Set endrange2 = Cells(2, c + 2)

For i = 1 To Cells(2, c + 3).Value
begrange = begrange + endrange - 1

With Range(Cells(2, c + 2), Cells(iLastRow, c + 2))
Set endrange2 = .Find(What:="*", AFTER:=endrange2, _
LookIn:=xlValues, LookAt:=xlWhole,
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
End With

endrange = endrange2.Row
endrange = endrange - begrange + 1

For j = 3 To 31 Step 7

'with or without
******************************************************************
objSheet.Range(objSheet.Cells(begrange, j), objSheet.Cells(begrange,
j).Offset(endrange, 6)).Select
'*******************************************************************************
objSheet.Range(objSheet.Cells(begrange, j), objSheet.Cells(begrange,
j).Offset(endrange, 6)).Sort _
Key1:=objSheet.Range(objSheet.Cells(begrange, j), _
objSheet.Cells(begrange, j).Offset(endrange, 6)),
Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
Next j
Next i

objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(2,
2).Offset(iLastRow, c)).Sort _
Key1:=objSheet.Range(objSheet.Cells(2, c), _
objSheet.Cells(2, 2).Offset(iLastRow, c)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range(Cells(2, c), Cells(iLastRow, c + 4)).Clear
Cells(2, 3).Select

MsgBox "Sort complete.", vbInformation

End Sub

I tested with original access database and output excel file and
standalone excel file with only 1000 equal rows.
sample data
c2 ak2
c1000 ak1000
76 87 58 38 26 42 83 22 64 88 44 78 66 68 45 42 17 27 51 21 34 77 79
89 77 86 55 81 9 15 27 43 62 31 13
desire result
26 38 42 58 76 83 87 22 44 64 66 68 78 88 17 21 27 34 42 45 51 55 77
77 79 81 86 89 9 13 15 27 31 43 62

Regards

Roger Govier

Regards

 

[Marco]

I send a reply email.

Regards
Marco

Hi Marco

I have received your data with 7,700 rows and tested with it.

Let me start by saying I was talking rubbish originally. Sorting by row
length and then carrying out the Left to Right sort is nonsense. It worked
for me as I only had 2 rows repeated 500 times each.
It will only sort left to right based on the first of the rows in a block,
so there is no alternative to going through your iteration 5 times on each
row in turn.

Under xL2003 it completed the sort in around 6 seconds (timed roughly with
a watch).
Under XL2007 it took 66 seconds.

I could not detect any difference in speed between using your original
Xl2003 code (modified by Jim Cone) and code created using the structure as
suggested by the XL2007 macro.

I did add lines to the code posted by Jim at the beginning and end as
follows
application.ScreenUpdating=False
application.calculation=xlmanual
setting them back to True and xlAutomatic at the end.

I have sent both the XL2007 and XL2003 files back to you directly.

--
Regards

Roger Govier

Hi Marco

It worked fine for me.Are you saying that the data was just one long row
of data that got wrapped by the newsreader, or is it 2 rows.
I took the sample that you sent originally as 2 rows one of length 25 and
the second of length 10.
That's why I did the preliminary sort to get all the 10 length rows
together, followed by the 25 length rows then sorted the rows back to
their original order at the end

If all of your data is of length 35, there is no need to do the
preliminary sort nor the final sort.

If you want to email me direct with a files with your data, I will ad the
code and send it back to you.
To mail direct remove NOSPAM from my address.

--
Regards

Roger Govier

"Roger Govier" wrote

Hi Marco
Hi Roger


Sure I have mistaken or lost something but don't work.

Sub OrderMany()
Dim objSheet As Excel.Worksheet
Dim iLastRow As Long, iLastColumn As Long
Dim i As Long, c As Long
Dim j As Long
Dim begrange As Long, endrange As Long, endrange2 As Range

Set objSheet = ActiveWorkbook.Worksheets(1)
iLastRow = objSheet.Cells(objSheet.Rows.Count, "c").End(xlUp).Row

Cells.Select
Cells.Find(What:="*", AFTER:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
MatchCase:=False, SearchFormat:=False).Activate
iLastColumn = ActiveCell.Column
c = iLastColumn + 12

objSheet.Cells(2, c).FormulaR1C1 = "1"
objSheet.Cells(3, c).FormulaR1C1 = "2"
Range(Cells(2, c), Cells(3, c)).Select
Selection.AutoFill Destination:=Range(Cells(2, c), Cells(iLastRow,
c)), Type:=xlFillDefault
Cells(2, c + 1).FormulaR1C1 = "=COUNT(RC[-37]:RC[-13])"
Cells(2, c + 1).Select
Selection.AutoFill Destination:=Range(Cells(2, c + 1),
Cells(iLastRow, c + 1))
Cells(2, c + 2).FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],"""",RC[-1])"
Cells(2, c + 2).Select
Selection.AutoFill Destination:=Range(Cells(2, c + 2),
Cells(iLastRow, c + 2))
Cells(2, c + 3).FormulaR1C1 = "=COUNT(C[-1]) -1"

objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(2,
2).Offset(iLastRow, c)).Sort _
Key1:=objSheet.Range(objSheet.Cells(2, c + 1), _
objSheet.Cells(2, 2).Offset(iLastRow, c)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Cells(iLastRow, c + 2) = iLastRow
begrange = 0: endrange = 2:
Set endrange2 = Cells(2, c + 2)

For i = 1 To Cells(2, c + 3).Value
begrange = begrange + endrange - 1

With Range(Cells(2, c + 2), Cells(iLastRow, c + 2))
Set endrange2 = .Find(What:="*", AFTER:=endrange2, _
LookIn:=xlValues, LookAt:=xlWhole,
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
End With

endrange = endrange2.Row
endrange = endrange - begrange + 1

For j = 3 To 31 Step 7

'with or without
******************************************************************
objSheet.Range(objSheet.Cells(begrange, j), objSheet.Cells(begrange,
j).Offset(endrange, 6)).Select
'*******************************************************************************
objSheet.Range(objSheet.Cells(begrange, j), objSheet.Cells(begrange,
j).Offset(endrange, 6)).Sort _
Key1:=objSheet.Range(objSheet.Cells(begrange, j), _
objSheet.Cells(begrange, j).Offset(endrange, 6)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
Next j
Next i

objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(2,
2).Offset(iLastRow, c)).Sort _
Key1:=objSheet.Range(objSheet.Cells(2, c), _
objSheet.Cells(2, 2).Offset(iLastRow, c)), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range(Cells(2, c), Cells(iLastRow, c + 4)).Clear
Cells(2, 3).Select

MsgBox "Sort complete.", vbInformation

End Sub

I tested with original access database and output excel file and
standalone excel file with only 1000 equal rows.
sample data
c2 ak2
c1000 ak1000
76 87 58 38 26 42 83 22 64 88 44 78 66 68 45 42 17 27 51 21 34 77 79 89
77 86 55 81 9 15 27 43 62 31 13
desire result
26 38 42 58 76 83 87 22 44 64 66 68 78 88 17 21 27 34 42 45 51 55 77 77
79 81 86 89 9 13 15 27 31 43 62



Regards

Roger Govier


Regards