CODEWITHSUNDEEP
excelvba
rollsboy1979
rollsboy1979

Reputation: 23

For a range of cells, first find the cells that are a certain color, then, for those cells, find if any are blank

I am trying to write a code for Excel in VBA which looks at a range of cells, in this example Range B4:B15, and first identifies which cells have a yellow fill color (interior color). Then of the cells colored yellow determine if any of those cells are blank.

If any of the yellow cells are blank, give a message for the entire range saying "there are yellow cells that are blank".

I'm using a For each rcell in r loop to determine which cells are yellow colored.

How do I build a new "sub-range" with only the cells colored yellow?

Sub Input_Checker_test()
    Dim ws As Worksheet
    Set ws = Sheets("Main")
    Dim r As Range
    Dim rcell As Range
    Dim rmain As Range
    Dim rmaincell As Range
    Set r = Range("B4:B15").Cells   
    For Each rcell In r   
        If rcell.Interior.Color = 65535 Then
            rcell = rmain
        End If
    Next rcell
    For Each rmaincell In rmain
        If WorksheetFunction.CountA(rmain) = 0 Then
            MsgBox ("Cells are empty")
        Else
            MsgBox ("Cells are full")
        End If     
    Next rmaincell           
End Sub

Upvotes: 0

Views: 366

Answers (1)

Darrell H
Darrell H

Reputation: 1886

I'm a little confused because you said font, then interior. If there is a yellow font, then there has to be a value, so I assumed you meant interior. Since you only need one of each to meet your criteria, you don't need to create a sub-range. You can test to see if any cells meet both criteria.

Sub Input_Checker_test()

    Dim ws As Worksheet
    Set ws = Sheets("Main")

    Dim r As Range
    Dim rcell As Range
    Dim YellowCount as Integer
    Dim EmptyCount as Integer
    Set r = ws.Range("B4:B15")

    For Each rcell In r
        If rcell.Interior.Color = 65535 Then
            YellowCount = 1
            If IsEmpty(rcell) Then
                EmptyCount = 1
            End If
        End If
    Next rcell

    If YellowCount > 0 Then
        MsgBox "There are yellow cells"
    End If

    If EmptyCount > 0 Then
        MsgBox "There are empty cells"
    End If


End Sub

Upvotes: 0

Related Questions