What if an entity is on a 'Red' layer but the entity is not red when viewed on screen?  We will now add some additional filtering to compensate for this.

To do so, we must ask ourselvees the question, "If an entity is on a 'Red' layer, what color property values will result in it displaying as red?".   The answer?  If an entity is on a 'Red' layer, the color of the entity can be ByLayer and the entity will display as Red.  If an entity is on a 'Red' layer, the color of the entity can be 'Red' and the entity will display as Red.  So, our filter must look for entities on Red layers that have a color of either Red or ByLayer.  The code below does just that.  We use a group code of -4 to begin an OR statement for the color.  We then close off our OR statement with another group code of -4.

Sub RedLayersToMyRed()
   Dim RedLayers As String
   Dim MyLayer As AcadLayer
   Dim NewRedLayer As String
   Dim RedSS As AcadSelectionSet
   Dim GrpC(0 To 4) As Integer
   Dim GrpV(0 To 4) As Variant
   Dim CadEnt As AcadEntity
   For Each MyLayer In ThisDrawing.Layers
      If MyLayer.Color = acRed Then
         If RedLayers = "" Then
               RedLayers = MyLayer.Name
            Else
               RedLayers = RedLayers & "," & MyLayer.Name
         End If
      End If
   Next
   Set RedSS = ThisDrawing.SelectionSets.Add("RedSS2")
   GrpC(0) = 8: GrpV(0) = RedLayers
   GrpC(1) = -4: GrpV(1) = "<OR"
   GrpC(2) = 62: GrpV(2) = acByLayer 'Color is ByLayer
   GrpC(3) = 62: GrpV(3) = acRed 'Color is Red
   GrpC(4) = -4: GrpV(4) = "OR>"
   RedSS.Select acSelectionSetAll, , , GrpC, GrpV
   NewRedLayer = "XYZ"
   For Each CadEnt In RedSS
      CadEnt.Layer = NewRedLayer
   Next
   RedSS.Delete
End Sub

The entities matching our selection criteria are moved to the layer specified in the NewRedLayer variable.  In this example, they are moved to a layer named "XYZ".

Happy Programming.