Morning, I have the following piece of code that highlights rows depending on various conditions. This is an extension upon your recommendation of putting the code in Private Sub Worksheet_Calculate() to allow the process to run continuously without user interference.
The problem is the value in D1 is always moving and when the condition is met the row is highlighted but as soon as the value in D1 changes, the highlight clears - I don't want this. I want the highlight to remain. Can you help please? Here's the code:
Private Sub Worksheet_Calculate()
Dim lLastRow As Long, Data1, ColE, ColG, ColH, COlI, lRow As Long
Dim shtThis As Worksheet, bThisRow As Boolean
Data1 = Cells(1, 4).Value
Set shtThis = ActiveSheet
With Cells(5, 1).CurrentRegion
lLastRow = .Rows.Count + .Row - 1
End With
For lRow = 5 To lLastRow
ColE = Cells(lRow, 5).Value
ColG = Cells(lRow, 7).Value
ColH = Cells(lRow, .Value
COlI = Cells(lRow, 9).Value
bThisRow = False
Select Case ColG
Case "DNT"
If ColH = Data1 Or COlI = Data1 Then _
bThisRow = True
Case "OT"
If ColE = Data1 Then _
bThisRow = True
Case "RKO", "KO"
Select Case ColF
Case "C"
If COlI = Data1 Then _
bThisRow = True
Case "P"
If ColH = Data1 Then _
bThisRow = True
End Select
End Select
With shtThis.Rows(lRow)
If bThisRow Then
With .Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Else
With .Interior
.ColorIndex = xlNone
.Pattern = xlNone
End With
End If
End With
Next
The problem is the value in D1 is always moving and when the condition is met the row is highlighted but as soon as the value in D1 changes, the highlight clears - I don't want this. I want the highlight to remain. Can you help please? Here's the code:
Private Sub Worksheet_Calculate()
Dim lLastRow As Long, Data1, ColE, ColG, ColH, COlI, lRow As Long
Dim shtThis As Worksheet, bThisRow As Boolean
Data1 = Cells(1, 4).Value
Set shtThis = ActiveSheet
With Cells(5, 1).CurrentRegion
lLastRow = .Rows.Count + .Row - 1
End With
For lRow = 5 To lLastRow
ColE = Cells(lRow, 5).Value
ColG = Cells(lRow, 7).Value
ColH = Cells(lRow, .Value
COlI = Cells(lRow, 9).Value
bThisRow = False
Select Case ColG
Case "DNT"
If ColH = Data1 Or COlI = Data1 Then _
bThisRow = True
Case "OT"
If ColE = Data1 Then _
bThisRow = True
Case "RKO", "KO"
Select Case ColF
Case "C"
If COlI = Data1 Then _
bThisRow = True
Case "P"
If ColH = Data1 Then _
bThisRow = True
End Select
End Select
With shtThis.Rows(lRow)
If bThisRow Then
With .Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Else
With .Interior
.ColorIndex = xlNone
.Pattern = xlNone
End With
End If
End With
Next