Thread: Looping Sort
View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
Per Jessen Per Jessen is offline
external usenet poster
 
Posts: 1,533
Default Looping Sort

Glad you found the variable error. You have a 'Next' statement too much:

Sub ColourSort()
Dim i As Integer
Dim intHowManyRow As Integer
Dim intStartRow As Integer
Dim intEndRow As Integer
Dim Mysht As Worksheet
Dim SortArray(2 To 8)
Dim TargetRange As Range

Application.ScreenUpdating = False
Set Mysht = ActiveSheet

intHowManyRow = Mysht.UsedRange.Rows.Count
intStartRow = 2
intEndRow = intStartRow + intHowManyRow - 1

For r = intStartRow To intEndRow
Set TargetRange = Mysht.Range("T" & r, Mysht.Range("Z" & r))
Set f = TargetRange.Find(what:="K")
If Not f Is Nothing Then
SortArray(2) = "K"
f.Value = ""
End If
Set f = TargetRange.Find(what:="C")
If Not f Is Nothing Then
SortArray(3) = "C"
f.Value = ""
End If
Set f = TargetRange.Find(what:="M")
If Not f Is Nothing Then
SortArray(4) = "M"
f.Value = ""
End If
Set f = TargetRange.Find(what:="Y")
If Not f Is Nothing Then
SortArray(5) = "Y"
f.Value = ""
End If
Counter = 6
For Each cell In TargetRange.Cells
If cell.Value < "" Then
SortArray(Counter) = cell.Value
cell.Value = ""
Counter = Counter + 1
End If
Next
'Next <=== this statement has to be deleted or commented out
For c = 2 To 8
Cells(r, 18 + c) = SortArray(c)
Range(Cells(r, 24), Cells(r, 26)).Sort _
Key1:=Mysht.Range(Cells(r, 19), Cells(r, 26)), _
Order1:=xlAscending, _
Header:=xlNo, _
Orientation:=xlLeftToRight
Next
Erase SortArray
Next
Application.ScreenUpdating = True
End Sub

Regards,
Per

"Bam" skrev i meddelelsen
...
Fixed the 1004 error. Changed the i's to r's.

Am trying to get this to work, but i think it's missing some next "x" or
something?

Sub ColourSort()
Dim i As Integer
Dim intHowManyRow As Integer
Dim intStartRow As Integer
Dim intEndRow As Integer
Dim Mysht As Worksheet
Dim SortArray(2 To 8)
Dim TargetRange As Range

Application.ScreenUpdating = False
Set Mysht = ActiveSheet

intHowManyRow = Mysht.UsedRange.Rows.Count
intStartRow = 2
intEndRow = intStartRow + intHowManyRow - 1

For r = intStartRow To intEndRow
Set TargetRange = Mysht.Range("T" & r, Mysht.Range("Z" & r))
Set f = TargetRange.Find(what:="K")
If Not f Is Nothing Then
SortArray(2) = "K"
f.Value = ""
End If
Set f = TargetRange.Find(what:="C")
If Not f Is Nothing Then
SortArray(3) = "C"
f.Value = ""
End If
Set f = TargetRange.Find(what:="M")
If Not f Is Nothing Then
SortArray(4) = "M"
f.Value = ""
End If
Set f = TargetRange.Find(what:="Y")
If Not f Is Nothing Then
SortArray(5) = "Y"
f.Value = ""
End If
Counter = 6
For Each cell In TargetRange.Cells
If cell.Value < "" Then
SortArray(Counter) = cell.Value
cell.Value = ""
Counter = Counter + 1
End If
Next
Next
For c = 2 To 8
Cells(r, 18 + c) = SortArray(c)
Range(Cells(r, 24), Cells(r, 26)).Sort _
Key1:=Mysht.Range(Cells(r, 19), Cells(r, 26)), _
Order1:=xlAscending, _
Header:=xlNo, _
Orientation:=xlLeftToRight
Next
Erase SortArray
Next
Application.ScreenUpdating = True
End Sub



"Bam" wrote:

I know this will be the answer, however i'm getting an "1004' error.

Debug = Cells(i, 18 + c) = SortArray(c)

Any thoughts?

Thanks for your help.

Bam.

"Per Jessen" wrote:

Hi

Try this:

Sub Colour_Sort()
Dim i As Integer
Dim intHowManyRow As Integer
Dim intStartRow As Integer
Dim intEndRow As Integer
Dim Mysht As Worksheet
Dim SortArray(2 To 8)
Dim TargetRange As Range

Application.ScreenUpdating = False
Set Mysht = ActiveSheet

intHowManyRow = Mysht.UsedRange.Rows.Count
intStartRow = 2
intEndRow = intStartRow + intHowManyRow - 1

For r = intStartRow To intEndRow
Set TargetRange = Mysht.Range("T" & r, Mysht.Range("Z" & r))
Set f = TargetRange.Find(what:="K")
If Not f Is Nothing Then
SortArray(2) = "K"
f.Value = ""
End If
Set f = TargetRange.Find(what:="C")
If Not f Is Nothing Then
SortArray(3) = "C"
f.Value = ""
End If
Set f = TargetRange.Find(what:="M")
If Not f Is Nothing Then
SortArray(4) = "M"
f.Value = ""
End If
Set f = TargetRange.Find(what:="Y")
If Not f Is Nothing Then
SortArray(5) = "Y"
f.Value = ""
End If
Counter = 6
For Each cell In TargetRange.Cells
If cell.Value < "" Then
SortArray(Counter) = cell.Value
cell.Value = ""
Counter = Counter + 1
End If
Next
For c = 2 To 8
Cells(i, 18 + c) = SortArray(c)
Range(Cells(i, 24), Cells(i, 26)).Sort _
Key1:=Mysht.Range(Cells(i, 19), Cells(i, 26)), _
Order1:=xlAscending, _
Header:=xlNo, _
Orientation:=xlLeftToRight
Next
Erase SortArray
Next
Application.ScreenUpdating = True
End Sub

Hopes this helps.
....
Per

"Bam" skrev i meddelelsen
...
Sorry, I didn't really explain that well.

I'm using excel 2003.

Call them "Text" fields Instead. They are not actually colored cells,
they
are words.

(They are actual codes OF "Colors" for the Printing Industry)

Cell 1 = "PMS0875"
Cell 2 = "K"
Cell 3 = "C"
Cell 4 = "M"
Cell 5 = "Y"
Cell 6 = "PMS0385"
Cell 7 = "PMS0386"
Cell 8 = "PMS0387"

So, I really want Cells 2-4 to always be K C M Y
(K = Black, C = Cyan, M = Magenta, Y = Process Yellow)

Then, if when i sort the cells "IF" i find any of these "values" i
want to
put them into this specific order.
I didn't want to confuse the original question too much, but if say
the
cells only contained "PMS0875" & "C". I really want it to do
something
like
this, where it skips cell 2 becuase it knows the "C" MUST go into
Cell 3.

Cell 1 = "PMS0875"
Cell 2 = "-"
Cell 3 = "C"

Leaving the rest of the cells blank.

Another example.

If the cells contained "PMS0875" , "C" , "Y" , "PMS1475" I really
want it
to
do something like this.

Cell 1 = "PMS0875"
Cell 2 = "-"
Cell 3 = "C"
Cell 4 = "-"
Cell 5 = "Y"
Cell 6 = "PMS1472"

Cells 7 & 8 blank.

It knows "C" must go in Cell 3 - if found.
It knows "Y" must go in Cell 5 - if found.

Hope this clarifies it a little better??

Cheers,

Bam.


"Nigel" wrote:

Your sort code is sorting on the cell values - what determines the
colours?
Is it conditional sort? Also which version of Excel are you using.
xl2007
has more sort options they may be useful.

--

Regards,
Nigel




"Bam" wrote in message
...
Hi All,

I've written this code, sorry, adapted this code from code I have
found
on
this sight, but have come to problem.

I'm trying to sort Colors, Real colors like CMYK, PMS colours
etc..

I sort the colours that are contained within 8 cells of a row. Eg:
S2:Z2
by
using this code.

Sub Colour_Sort()
Dim i As Integer
Dim intHowManyRow As Integer
Dim intStartRow As Integer
Dim intEndRow As Integer
Dim Mysht As Worksheet

Set Mysht = ActiveSheet

intHowManyRow = Mysht.UsedRange.Rows.Count
intStartRow = 2
intEndRow = intStartRow + intHowManyRow - 1
Application.ScreenUpdating = False
For i = intStartRow To intEndRow
Range(Cells(i, 19), Cells(i, 26)).Sort _
Key1:=Mysht.Range(Cells(i, 19), Cells(i, 26)), _
Order1:=xlDescending, _
Header:=xlNo, _
Orientation:=xlLeftToRight
Next i
Application.ScreenUpdating = True
End Sub


However, I would like to have certain colors always appear in a
particular
column.

Eg:
1st - WHITE or PMS8*
2nd - K
3rd - C
4th - M
5th - Y
6th - Any
7th - Any
8th - Any

Can anyone offer a suggestion on if or how this could be done?

Appreciate any help given.

Cheers,

Bam.