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

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
DarrenJacksonAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
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
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
DarrenJacksonAuthor Commented:
Absolutely perfect. Thankyou Thankyou
0
John TsioumprisSoftware & Systems EngineerCommented:
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

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.