troubleshooting Question

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

Avatar of DarrenJackson
DarrenJacksonFlag for United Kingdom of Great Britain and Northern Ireland asked on
Microsoft ExcelVBAMicrosoft Office
3 Comments1 Solution130 ViewsLast Modified:
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
Join our community to see this answer!
Unlock 1 Answer and 3 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 3 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros