Looping VBA code to check for highlighted cells

Question

I would like a code to check every cell in range A1:A14 and if the cell is highlighted say yes or no in column B.

.

Sub highlighted()

 Dim rng As Range
 Dim c As Range

    Set rng = ActiveCell

    For Each c In rng

      If c.Interior.Pattern <> xlNone Then

        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.FormulaR1C1 = "Yes"

    Exit Sub

    End If

  Next c

End Sub

This code works sucsessfully for one single highlighted cell, how can I get it to loop through my desired range, and also include the "no" for non-highlighted cells?

Thanks In Advance!

score 1 · Accepted Answer · answered Nov 07 '19 at 23:51

This would be the code. Read the comments and adjust according your needs.

Sub highlighted()

    Dim evaluatedRange As Range
    Dim evaluatedCell As Range

    Dim sheetName As String
    Dim rangeAddress As String

    ' Adjust these two parameters
    sheetName = "Sheet1"                         ' Sheet name where the range is located
    rangeAddress = "A1:A14"

    Set evaluatedRange = ThisWorkbook.Worksheets(sheetName).Range(rangeAddress)

    ' This will loop through each cell in the range
    For Each evaluatedCell In evaluatedRange

        ' Evaluates if the cell has a pattern (what ever it is)
        If evaluatedCell.Interior.Pattern <> xlNone Then

            ' Set the value of the cell next to the one evaluated (same row - rowOffset:=0 but next column columnOffset:=1) to Yes
            evaluatedCell.Offset(rowOffset:=0, columnOffset:=1).Value = "Yes"

            ' Exit Sub -> This would exit the whole process, so if you want to evaluate the whole range, just delete this line
        Else

            evaluatedCell.Offset(rowOffset:=0, columnOffset:=1).Value = "No"

        End If

    Next evaluatedCell

    MsgBox "Process finished!" ' -> alert the user...

End Sub

If this is what you need, remember to mark the answer to help others.

score 0 · Answer 2 · answered Nov 07 '19 at 23:54

If I understand what you are trying to do, you could simply do:

Sub highlighted()
   Dim rng As Range
   Dim c As Range

   Set rng = Range("A1:A14")
   For Each c In rng
        If c.Interior.Pattern <> xlNone Then 
            c.Range("A1").Offset(0,1).Value = "Yes"
        End If
   Next c
End Sub

See How to avoid using Select in Excel VBA for tips on avoiding unneeded Selects

Looping VBA code to check for highlighted cells

2 Answers2