简体   繁体   中英

Highlight cells based on cell content with Excel VBA

This is for an Microsoft Excel VBA macro. What it is supposed to do, for every row, when "Late" is entered into column C, to highlight the cell 2 spaces to the left and Range of cells 3 spaces to the right through 43. So example is C4 contains "Late", highlight A4 and F4:AW4. Same goes for the word "Hold" just a different color.

Private Sub Highlight_Condition(ByVal Target As Range)

Dim lastRow As Long
Dim cell As Range
Dim i As Long
With ActiveSheet
  lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
  Application.EnableEvents = False
  For i = lastRow To 1 Step -1
     If .Range("C" & i).Value = "LATE" Then
        Debug.Print "Checking Row: " & i
        .Range("A" & i).Interior.ColorIndex = 39
        .Range("F" & i & ":AW" & i).Interior.ColorIndex = 39
     ElseIf .Range("C" & i).Value = "HOLD" Then
        .Range("A" & i).Interior.ColorIndex = 43
        .Range("F" & i & ":AW" & i).Interior.ColorIndex = 43
     Else
        .Range("A" & i & ":AW" & i).ClearContents
        .Range("F" & i & ":AW" & i).ClearContents

     End If
  Next i
  Application.EnableEvents = True
End With
End Sub

This should work for you...

Private Sub Highlight_Condition(ByVal Target As Range)

Dim lastRow As Long
Dim cell As Range
Dim i As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Application.EnableEvents = False
For i = lastRow To 1 Step -1
 If .Range("C" & i).Value = "LATE" Then
    Debug.Print "Checking Row: " & i
    .Range("A" & i).Interior.ColorIndex = 39
    .Range("F" & i & ":AW" & i).Interior.ColorIndex = 39
 ElseIf .Range("C" & i).Value = "HOLD" Then
    .Range("A" & i).Interior.ColorIndex = 43
    .Range("F" & i & ":AW" & i).Interior.ColorIndex = 43
 Else
    .Range("A" & i & ":AW" & i).ClearContents
    .Range("F" & i & ":AW" & i).ClearContents

 End If
Next i
Application.EnableEvents = True
End With
End Sub

Tested and seems to work fine for me :)

... C4 contains "Late" ... (emphasis mine)

This seems to indicate that Late may be part of a longer string. I will code to that effect.

Conditional formatting rules are a quick method of achieving your cell highlighting and respond as soon as values in column C change without rerunning the sub procedure (unless more values are added below the lastRow ).

Option Explicit

Sub Macro1()
    Const TEST_COLUMN As String = "D"
    Dim lastRow As Long, sSheetName As String

    sSheetName = ActiveSheet.Name

    With Worksheets(sSheetName)
        lastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
        With .Range("A4:A" & lastRow & ", F4:AW" & lastRow)
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:="=isnumber(search(""late"", $c4))"
            .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 39
            .FormatConditions.Add Type:=xlExpression, Formula1:="=isnumber(search(""hold"", $c4))"
            .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 43
        End With
    End With

End Sub

Great! I wanted to run this in the worksheet and not as a module. So i added a few extra lines and ByVal Target As Range to fire everytime a change is made in the range but it doesn't seem to work. Am i missing something?

Private Sub Highlight_Condition(ByVal Target As Range)

Dim LastRow As Long
Dim cell As Range
Dim i As Long
With ActiveSheet
  LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
  Application.EnableEvents = False
  For i = LastRow To 1 Step -1
     If .Range("C" & i).Value = "LATE" Then
        Debug.Print "Checking Row: " & i
        .Range("A" & i).Interior.ColorIndex = 39
        .Range("F" & i & ":AW" & i).Interior.ColorIndex = 39
     ElseIf .Range("C" & i).Value = "HOLD" Then
        .Range("A" & i).Interior.ColorIndex = 43
        .Range("F" & i & ":AW" & i).Interior.ColorIndex = 43
     Else
        .Range("A" & i).EntireRow.Interior.ColorIndex = xlNone
     End If
  Next i
  Application.EnableEvents = True
End With

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM