Thread: Looping Sort
View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Bam Bam is offline
external usenet poster
 
Posts: 48
Default Looping Sort


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.