Solved: Sort Data and color code

[john3j]

Hey guys,

I have yet another problem I am running into. I have a main sheet and I need it to sort through this main sheet and according to what the value is in each cell in column C, it will paste the data into the appropriate sheets. From there I need to color code everything, make sure that rows are deleted from the main page, and everything that is pasted on the new pages has borders around every cell in the worksheet. I dont know if I should sort first and then color code, or if I should do it the other way around. If you look at the attachment and check out my code you will see that part of it doesnt work. It will not delete the rows that has deleted... or cancelled... in column y. Plus the whole color coding thing takes a while. Time is not that big of a deal, but would be nicer if there was a more efficient way of doing it.

Here is the basic criteria:

If Column C of “Master List” contains “08”, then delete that row before sorting.
Sort data to each page depending on Value in Column C.
Execute color coding for each page in spreadsheet.
Clear all contents and formatting from main sheet after pasting data into other sheets.

For each cell in column Y of sheet “Master List”

If value in Column Y equals “Cancelled *If chosen, please state reason.” Then delete the whole row prior to sorting.
If value in Column Y equals “Deleted *If chosen, please state reason.” Then delete the whole row prior to sorting.
If value in column Y equals “Contract Awarded” Then set the whole row color to 35.
If value in column Y equals “Part A Held” Then set the whole row color to 34.
If value in column Y equals “Part B Accepted” Then set the whole row color to 38.
If value in column Y equals “Part B Submitted” Then set the whole row color to 36.
If value in column Y equals “Planning” Then set the whole row color to 2.
If value in column Y equals “Postponed” Then set whole row color to 39.

Here is a copy of the code that I am currently using.

Private Sub ColorRange()

'Code Written By: John Strange
'Date: 2/17/2009


Range("A1").Select

Set MyRange = Range("C2:C1000")
MyRange.Select
For Each cell In MyRange

If cell.Value <= "08" Then
cell.EntireRow.delete
End If
Next

Set MyRange = Range("C2:C1000")
MyRange.Select
For Each cell In MyRange

If cell.Text = "Cancelled *If chosen, please state reason." Then
cell.EntireRow.delete
End If
Next

Set MyRange = Range("C2:C1000")
MyRange.Select
For Each cell In MyRange

If cell.Text = "Deleted *If chosen, please state reason." Then
cell.EntireRow.delete
End If
Next

'This outlines every cell in the sheet
Set MyRange = Range("A2:AB1000")
MyRange.Select
Selection.Borders.LineStyle = xlContinuous
'This Removes extra rows that are empty
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.delete


'This portion of the code Changes the color of rows based
' on the criteria in column AB

'This changes row to light green if cell contains "Contract Awarded"

Set MyRange = Range("Y2:Y1000")
For Each cell In MyRange

If cell.Value = "Contract Awarded" Then
cell.EntireRow.Select
cell.EntireRow.Interior.ColorIndex = 35
cell.EntireRow.Font.ColorIndex = 1
' break
End If
Next

'This changes row to light blue if cell contains "Part A Held"

Set MyRange = Range("Y2:Y1000")
MyRange.Select
For Each cell In MyRange

If cell.Value = "Part A Held" Then
cell.EntireRow.Select
cell.EntireRow.Interior.ColorIndex = 34
cell.EntireRow.Font.ColorIndex = 1
' break
End If
Next

'This changes row to pink if cell contains "Part B Accepted"

Set MyRange = Range("Y2:Y1000")
MyRange.Select
For Each cell In MyRange

If cell.Value = "Part B Accepted" Then
cell.EntireRow.Select
cell.EntireRow.Interior.ColorIndex = 38
cell.EntireRow.Font.ColorIndex = 1
' break
End If
Next

'This changes row to light yellow if cell contains "Part B Submitted"

Set MyRange = Range("Y2:Y1000")
MyRange.Select
For Each cell In MyRange

If cell.Value = "Part B Submitted" Then
cell.EntireRow.Select
cell.EntireRow.Interior.ColorIndex = 36
cell.EntireRow.Font.ColorIndex = 1
' break
End If
Next

'This changes row to white if cell contains "Planning"

Set MyRange = Range("Y2:Y1000")
MyRange.Select
For Each cell In MyRange

If cell.Value = "Planning" Then
cell.EntireRow.Select
cell.EntireRow.Interior.ColorIndex = 2
cell.EntireRow.Font.ColorIndex = 1
' break
End If
Next

'This changes row to white if cell contains "Postponed"

Set MyRange = Range("Y2:Y1000")
MyRange.Select
For Each cell In MyRange

If cell.Value = "Postponed" Then
cell.EntireRow.Select
cell.EntireRow.Interior.ColorIndex = 39
cell.EntireRow.Font.ColorIndex = 1
' break
End If
Next


End Sub

Private Sub CommandButton1_Click()
Call ColorRange
Call ID_Allocate
End Sub
Sub ID_Allocate()
Dim Rng As Range
Dim Cel As Range
Dim tgt As Range
Dim MainSheet As Worksheet
Dim ws As Worksheet
Dim arr, a

'Clear sheets prior to pasting data
arr = Array("08", "09", "10", "11", "12", "13")
For Each a In arr
Sheets(a).Range("A2:AA1000").ClearContents
Next

Set MainSheet = Sheets("Master List")
With MainSheet
'Set Division range
Set Rng = Range(.Cells(2, 3), .Cells(Rows.Count, 3).End(xlUp))
'Loop through each cel
For Each Cel In Rng
'Determine target sheet
Set ws = Sheets(Cel.Text)
'Check for next vacant cell
Set tgt = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1)
'Copy and paste data
Cel.Offset(, -2).Resize(, 27).Copy tgt

Next
End With



'Clear data
Rng.Offset(, -2).Resize(, 27).ClearContents
End Sub

[p45cal]

Running down the rows while deleting some of them will skip some rows, you should run UP the rows. The attached has code which runs up the rows, determining whether each one should be deleted, or coloured and moved to another sheet. Since you've sanitised the contents I had to change some code to suit.
For those intetrested the code:
Sub blah()
'Clear sheets prior to pasting data
For Each a In Array("08", "09", "10", "11", "12", "13")
Sheets(a).Range("A2:AA1000").ClearContents
Next
LastRow = Cells(Rows.Count, 3).End(xlUp).Row
For rw = LastRow To 2 Step -1
If Cells(rw, 3).Value <= "08" Or InStr(Cells(rw, 25).Value, "*If chosen") > 0 Then
Cells(rw, 1).EntireRow.delete
Else
Select Case Cells(rw, 25).Value
Case "Contract Awarded"
Rows(rw).Interior.ColorIndex = 35
Rows(rw).Font.ColorIndex = 1
Case "Part A Held"
Rows(rw).Interior.ColorIndex = 34
Rows(rw).Font.ColorIndex = 1
Case "Part B Accepted"
Rows(rw).Interior.ColorIndex = 38
Rows(rw).Font.ColorIndex = 1
Case "Part B Submitted"
Rows(rw).Interior.ColorIndex = 36
Rows(rw).Font.ColorIndex = 1
Case "Planning"
Rows(rw).Interior.ColorIndex = 2
Rows(rw).Font.ColorIndex = 1
Case "Postponed"
Rows(rw).Interior.ColorIndex = 39
Rows(rw).Font.ColorIndex = 1
End Select
Set ws = Sheets(Cells(rw, 3).Text)
'Check for next vacant cell
Set tgt = ws.Cells(Rows.Count, 3).End(xlUp).Offset(1, -2) 'changed because there's nothing in column A
'Copy and paste data
' Cells(rw, 1).Resize(, 27).Copy tgt
'CUT and paste data
Cells(rw, 1).Resize(, 27).Cut tgt
End If
Next rw
'ActiveSheet.UsedRange.Offset(1).Clear 'you can (visually) check that there are no lines left on Master List sheet before executing this line.
End SubNo Option Explicit, no Dimming, I leave that to you. I've left the line out which deletes entirte rows containing nothing in column A, because you sanitised those too.

[john3j]

The code you provided works great, and so muc more efficiently and I really appreciate your help. I do have one more question though. After the data is sorted into the different sheets, can it be sorted again so that it displays them in the following order, based on contents of column Y:

1. Planning
2. Part A Held
3. Part B Submitted
4. Part B Accepted
5. Contract Awarded

I guess I am just trying to automate selecting column Y, choosing sort, and expanding the current selection. I just dont want it sorted in ascending or descending. I would like to see it sorted as listed above. If you could provide any insight on this it would be greatly appreciated. Thank you!

Also, what do you mean when you say sanitised? And how do I mark a thread as resolved?

[p45cal]

Since you want to sort on something that is neither numerical nor alphabetic, one answer is to add a helper column containing a formula of the ilk:

=MATCH(Y4,{"Planning","Part A Held","Part B Submitted","Part B Accepted","Contract Awarded"},0)and copy it down, then sort the range on that.
Alternatively, in the select case part of the vba code add a value at the right end of the range you're copying, sort later on that column then erase the values. Record yourself sorting and adapt the code. Look at the help file on CurrentRegion

Sanitised.. I meant that you'd cleaned the sheet of sensitive data so that you could put it in the public domain. That assumption comes from the fact that your code looks for non-empty cells among cells with data - one statement would have resulted in most or all of the rows being deleted.

marking a thread as solved - yes, I too had to hunt around for this the first time I wanted to do it, look for a 'Thread Tools' dropdown, immediately above the topmost thread, on the right.