john3j
04-02-2009, 10:45 AM
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
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