PDA

View Full Version : [SOLVED:] Macro that sorts a specific column by colors and value.



Zlerp
10-22-2014, 10:33 AM
Hello,

I am trying to create a macro that will sort my data by color. It will look through column C starting C4. i need it to sort by 12 colors then sort alphabetically within the color sorting.

this will expand to all selections and this will sort to the last row of data in column C. This also needs to start by switching the Active sheet to a sheet called "New Property"

This is my code as of now but i am having errors:


Sub SortByColour()
Dim wks As Worksheet

' change to whichever sheet you want
Set wks = ActiveSheet


With wks.Sort
With .SortFields
.Clear
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(79, 129, 189)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(184, 204, 228)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(117, 146, 60)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(194, 214, 154)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(234, 241, 221)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 153)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 255)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(240, 240, 244)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(219, 229, 241)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(253, 233, 217)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(252, 213, 180)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(204, 192, 218)
.Add Key:=wks.Range("C4"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
End With


End Sub




Thank you for help,
Zlerp

p45cal
10-22-2014, 03:54 PM
try something along these lines- it will need a tweak or two and I've guessed about headers:
Sub blah()
Set wks = ActiveSheet 'ActiveWorkbook.Worksheets("Sheet1")
With wks.Sort
With .SortFields
.Clear
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(79, 129, 189)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(184, 204, 228)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(117, 146, 60)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(194, 214, 154)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(234, 241, 221)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 153)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 255)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(240, 240, 244)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(219, 229, 241)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(253, 233, 217)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(252, 213, 180)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(204, 192, 218)
.Add Key:=Range("C4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
.SetRange wks.Range("C3:C39") 'adjust to suit (this has to be right).
.Header = xlYes 'I've guessed this.
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

Zlerp
10-23-2014, 09:53 AM
Hey p45cal,

first off thanks for the quick response!!

So after testing the code, it does create the custom sort which is great, but it does not auto sort and expand to the other columns which it needs to.

once i run it, it seems column C starts to sort but the sort is not in the correct order, and it misses many rows of data starting after row 39 of the data and i need to run until the last cell.

So here are the main issues with this code as of now:
1. It only sorts column C but there is data in A:P so the sort needs to expand to all the columns.
2. the custom sort is created, but the sort itself only works in column C to row 39


Once again, Thank you for your help! you have done more than enough to help me out. Anything extra will be greatly appreciated. Let me know if you have any questions on this.

Thanks,
Zlerp

Zlerp
10-23-2014, 09:54 AM
oops, just noticed some of your notes on the code itself. I will tweak it a bit and see if i can come up with a solution. I will let you know what i come up with. Thanks again

Zlerp
10-23-2014, 10:06 AM
Hey p45cal,

So i modified the code so it extends to the last row of data in column C. The only issue im still having is that it does nto expand to all columns. not sure how to fix this.

Heres the code as of now:

Sub sorting()
Set wks = ActiveSheet 'ActiveWorkbook.Worksheets("Sheet1")
Dim lastRow As Long
lastRow = FindLastRow(ActiveSheet, "C")
With wks.Sort
With .SortFields
.Clear
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(79, 129, 189)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(184, 204, 228)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(117, 146, 60)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(194, 214, 154)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(234, 241, 221)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 153)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 255)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(240, 240, 244)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(219, 229, 241)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(253, 233, 217)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(252, 213, 180)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(204, 192, 218)
.Add Key:=Range("C4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
.SetRange wks.Range("C3:C" & lastRow) 'adjust to suit (this has to be right).
.Header = xlYes 'I've guessed this.
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Public Function FindLastRow(ByVal WS As Worksheet, ColumnLetter As String) As Long
' this function will find the last row of the worksheet and column that you
' request
FindLastRow = WS.Range(ColumnLetter & Rows.Count).End(xlUp).Row
End Function

Let me know if you have any ideas/suggestions. Once again thank you for your help!

Thanks,
Zlerp

Zlerp
10-23-2014, 10:16 AM
Hey p45cal,

i think i got it to work! So far so good! Thanks for your help! your assistance was greatly appreciated.

Here is the final code:

Sub sorting()
Set wks = ActiveSheet 'ActiveWorkbook.Worksheets("Sheet1")
Dim lastRow As Long
lastRow = FindLastRow(ActiveSheet, "C")
With wks.Sort
With .SortFields
.Clear
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(79, 129, 189)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(184, 204, 228)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(117, 146, 60)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(194, 214, 154)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(234, 241, 221)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 153)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 255)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(240, 240, 244)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(219, 229, 241)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(253, 233, 217)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(252, 213, 180)
.Add(wks.Range("C4"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(204, 192, 218)
.Add Key:=Range("C4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
.SetRange wks.Range("A3:P" & lastRow) 'adjust to suit (this has to be right).
.Header = xlYes 'I've guessed this.
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Public Function FindLastRow(ByVal WS As Worksheet, ColumnLetter As String) As Long
' this function will find the last row of the worksheet and column that you
' request
FindLastRow = WS.Range(ColumnLetter & Rows.Count).End(xlUp).Row
End Function


Thanks,
Zlerp