Cut/paste based off of RBG color

Question

The first macro creates four worksheets, names them, then searches the original worksheet for string words and colors them based off of RBG and sort them. I never have an issue running this macro.

My second macro should cut/paste things into their specified worksheet. It never works.

Macro 1 that creates worksheets, color codes, and sorts.

Sub MacroTest3()

' MacroTest3 Macro
'

'
Sheets.Add After:=ActiveSheet
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "DNIF"
Sheets.Add After:=ActiveSheet
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "Wx"
Sheets.Add After:=ActiveSheet
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "Preg"
Sheets.Add After:=ActiveSheet
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "<30"
Range("G34").Select
Sheets("Down Weekly").Select
Range("A1:A2").Select
Selection.Copy
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DNIF").Select
ActiveSheet.Paste
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("D:F").Select
Selection.Delete Shift:=xlToLeft
Columns("E:I").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Rows("1:3").Select
Selection.Delete Shift:=xlUp
Cells.Select   '------ selects all cell command!

'------------------------------------------------------------------------------'
' Looks for string "Waiver Log" then colors it Yellow
Selection.FormatConditions.Add Type:=xlTextString, String:="Waiver Log", _
    TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = RGB(255, 255, 0)
    .TintAndShade = 0
End With

'------------------------------------------------------------------------------'
' Looks for string "Waiver Hold" then colors it Yellow
Selection.FormatConditions.Add Type:=xlTextString, String:="Waiver Hold", _
    TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = RGB(255, 255, 0)
    .TintAndShade = 0
End With

'------------------------------------------------------------------------------'
' Looks for string "Pregn" then colors it Red
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlTextString, String:="Pregn", _
    TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = RGB(255, 0, 0)
    .TintAndShade = 0
End With

'---------------------------------------------------------------------------------'
' Sorts less than 30 days then colors cels orange
Columns("D:D").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
    "=D2>TODAY()-31"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = RGB(255, 192, 0)
End With
Selection.FormatConditions(1).StopIfTrue = False

'---------------------------------------------------------------------------------'
' Sorts Red cells to the top, yellow cells bellow it:
Sheets("DNIF").Select
Range("A1:G1").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("DNIF").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DNIF").Sort.SortFields.Add(Range("G2:G1000"), _
    xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 0 _
    , 0)
ActiveWorkbook.Worksheets("DNIF").Sort.SortFields.Add(Range("G2:G1000"), _
    xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
    255, 0)
ActiveWorkbook.Worksheets("DNIF").Sort.SortFields.Add(Range("D2:D1000"), _
    xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
    192, 0)
With ActiveWorkbook.Worksheets("DNIF").Sort
    .SetRange Range("A1:G1000")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'-----------------------------------------------------------------------'
' Copies the headers onto the different worksheets
Range("A1:G1").Select
Selection.Copy
Sheets("Wx").Select
ActiveSheet.Paste
Sheets("Preg").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("<30").Select
Range("A1").Select
ActiveSheet.Paste

End Sub

Second Macro to cut/paste rows based off of RBG color

Sub Copier()

Dim TransIDField As Range
Dim TransIDCell As Range
Dim OriginSheet As Worksheet
Dim TargetSheet As Worksheet
Dim TargetSheet2 As Worksheet

Set OriginSheet = Worksheets("Down Weekly")
Set TransIDField = OriginSheet.Range("G2", OriginSheet.Range("G2").End(xlDown))
Set TargetSheet = Worksheets("Preg")
Set TargetSheet2 = Worksheets("Wx")

For Each TransIDCell In TransIDField
    If TransIDCell.Interior.Color = RGB(255, 0, 0) Then
        TransIDCell.Resize(1, 7).Cut Destination:= _
            TargetSheet.Range("A1").Offset(TargetSheet.Rows.Count - 1, 
0).End(xlUp).Offset(1, 0)
    End If
Next TransIDCell

For Each TransIDCell In TransIDField
   If TransIDCell.Interior.Color = RGB(255, 255, 0) Then
        TransIDCell.Resize(1, 7).Cut Destination:= _
            TargetSheet2.Range("A1").Offset(TargetSheet2.Rows.Count - 1, 
0).End(xlUp).Offset(1, 0)
   End If
Next TransIDCell

End Sub

Whenever you do `Sheets.Add` it is very important to specify which workbook you want to add the sheet onto. You can use built in keywords like `ThisWorkbook` or `ActiveWorkbook` to reference the one you want. Otherwise, look for the workbook by name in `Application.Workbooks` like `Application.Workbooks("Report.xlsm").Sheets.Add` — Toddleson, Jul 06 '22 at 19:10
When you do `Sheets.Add` the new worksheet is returned by the method. You can save that worksheet object as a variable for later use: `Set DataSheet = Sheets.Add`. This will then let you do the rest of your code using that variable. like `DataSheet.Name = "New Name"` — Toddleson, Jul 06 '22 at 19:12
I think reading [How to avoid select](https://stackoverflow.com/q/10714251/16578424) would help you to refactor esp. your first macro. Then I would split the first macro in subs per each task. And then it will be much easier to understand and fix the errors — Ike, Jul 06 '22 at 19:12
You don't need to `Select` a sheet to rename it, you can safely remove all of the `Sheet.Select` lines. — Toddleson, Jul 06 '22 at 19:12
If in the future you DO need to select a cell for whatever reason, you can save coding time, messiness, confusion, and what-not by turning : `Sheets("<30").Select & Range("A1").Select` into `Sheets("<30").Range("A1").Select` — Cameron Critchlow, Jul 06 '22 at 19:22

Cut/paste based off of RBG color

0 Answers0