Link to home
Start Free TrialLog in
Avatar of DarrenJackson
DarrenJacksonFlag for United Kingdom of Great Britain and Northern Ireland

asked on

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
ASKER CERTIFIED SOLUTION
Avatar of Rgonzo1971
Rgonzo1971

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of DarrenJackson

ASKER

Absolutely perfect. Thankyou Thankyou
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