Looping Sort

[Bam]

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.

 

[Nigel]

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.

 

[Bam]

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.

 

[Per Jessen]

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]

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.

 

[Bam]

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

 

[Per Jessen]

My fault, I changed the 'i' variable to 'r' after testing the code but
missed a few i's.

Change i to r as below, and it should work...

---Cut---
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
---Cut---

Regards,
Per

 

[Per Jessen]

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]

No probs. getting a different error now.

If cell.Value <> "" Then
SortArray(Counter) = cell.Value - On this line
cell.Value = ""
Counter = Counter + 1
End If

Runtime Error "9"
Subscript out of range.

The sorting is working ok though. Exactly what i needed.

I need to log off now though. If you get the solution, i will really
appreciate it.

Look forward to looking it up tomorrow.

Thanks Pers, I know this will do it.

Bam.

 

[Per Jessen]

Hi Bam

I assumed that S2 will always contain PMS0875, and therefore skipped this
cell in the sort. If that is not true, shall S2 always be the first value
like "PMS*" or ?

If the above is not the case, do you have more than 3 values like "PMS*" to
be sorted.

Maybe you could post some sample data to be sorted, and below the expected
result.

Look forward to hear from you to morrow.

Per.