Finding cells in Excel 2016 that are either RED or YELLOW and returning a msg box with the cell references

DarrenJackson
DarrenJackson used Ask the Experts™
on
Guys

I have this vb code that when ran selects a region then checks if there is any cells that are RED if so a message box pops up telling me which ones are RED.
I also have another VB code which when ran tells me if any cell in a region is YELLOW then again a message box pops up and gives me those locations.

I would like it that when I run the code it checks for both colours and returns the locations in the same message box.

I am only wanting it to return If it is RED or YELLOW or both no other colours.

Can any one help

here is what I have so far

Sub SelectColoredRed()
    Dim rCell As Range
    Dim lColor As Long
    Dim rColored As Range
   
    lColor = vbRed
   
    Set rColored = Nothing
   
        Range("A1").Select
    Selection.CurrentRegion.Select
   
    For Each rCell In Selection
       If rCell.Interior.Color = lColor Then
            If rColored Is Nothing Then
                Set rColored = rCell
            Else
                Set rColored = Union(rColored, rCell)
            End If
        End If
    Next
    If rColored Is Nothing Then
        MsgBox "No cells match the color"
    Else
        rColored.Select
        MsgBox "Selected cells match the color RED:" & _
            vbCrLf & rColored.Address
    End If
    Set rCell = Nothing
    Set rColored = Nothing
End Sub

Sub SelectColoredYellow()
    Dim rCell1 As Range
    Dim lColor1 As Long
    Dim rColored1 As Range

   
    lColor1 = vbYellow

    Range("A1").Select
    Selection.CurrentRegion.Select

    Set rColored1 = Nothing
    For Each rCell1 In Selection
        If rCell1.Interior.Color = lColor1 Then
            If rColored1 Is Nothing Then
                Set rColored1 = rCell1
            Else
                Set rColored1 = Union(rColored1, rCell1)
            End If
        End If
    Next
    If rColored1 Is Nothing Then
        MsgBox "No cells match the color"
    Else
        rColored1.Select
        MsgBox "Selected cells match the color YELLOW:" & _
            vbCrLf & rColored1.Address
    End If
    Set rCell1 = Nothing
    Set rColored1 = Nothing
End Sub
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2016
Commented:
Hi,

pls try
Sub SelectColoredRedOrYellow()
     Dim rCell As Range
     Dim lColor As Long
     Dim rColored As Range
     
     lColor1 = vbRed
     lColor2 = vbYellow
    
     Set rColored = Nothing
     
         Range("A1").Select
     Selection.CurrentRegion.Select
     
     For Each rCell In Selection
        If rCell.Interior.Color = lColor1 or rCell.Interior.Color = lColor2  Then
             If rColored Is Nothing Then
                 Set rColored = rCell
             Else
                 Set rColored = Union(rColored, rCell)
             End If
         End If
     Next
     If rColored Is Nothing Then
         MsgBox "No cells match the color"
     Else
         rColored.Select
         MsgBox "Selected cells match the color RED or YELLOW:" & _
             vbCrLf & rColored.Address
     End If
     Set rCell = Nothing
     Set rColored = Nothing
 End Sub

Open in new window

REgards

Author

Commented:
Absolutely perfect. Thankyou Thankyou
John TsioumprisSoftware & Systems Engineer

Commented:
You should tweak the code so that it checks both red and yellow
    For Each rCell1 In Selection
        If rCell1.Interior.Color = RED OR rCell1.Interior.Color = YELLOW Then

Open in new window

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial