Worksheet Change Event - Colour infill cells
 

Hi,

I'm using the following to highlight some cells in my row if the cell in
column 9 contains data.
How do I remove the colour if/when the data is then deleted?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long, v As Variant
Dim cel As Range
Dim rng As Range
On Error GoTo errExit

Set rng = Intersect(Range(Range("I1"), _
Cells(Range("I500").End(xlUp).Row, 7)), Target)

If Not rng Is Nothing Then
For Each cel In rng
x = 0
With cel
If .Column = 9 Then 'col I

If .Value = "" Then
x = xlNone
Else
x = .Offset(0, -4).Interior.ColorIndex 'col B
End If
If .Interior.ColorIndex < x Then
.Interior.ColorIndex = x
End If

With .Resize(1, 14)
v = .Interior.ColorIndex
If IsNull(v) Then v = -1
If v < x Then
.Interior.ColorIndex = x
End If
End With
End If

If x Then
End If
End With
Next
End If
errExit:
End Sub

Regards
D Dawson

Worksheet Change Event - Colour infill cells
 

You need to set interior color to xlnone

If .Value = "" Then

----------------------------------------------
from x = xlNone

----------------------------------------------------------------
to x.Interior.ColorIndex = xlNone

----------------------------------------------------------------

Else
x = .Offset(0, -4).Interior.ColorIndex 'col B
End If


"dd" wrote:

Hi,

I'm using the following to highlight some cells in my row if the cell in
column 9 contains data.
How do I remove the colour if/when the data is then deleted?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long, v As Variant
Dim cel As Range
Dim rng As Range
On Error GoTo errExit

Set rng = Intersect(Range(Range("I1"), _
Cells(Range("I500").End(xlUp).Row, 7)), Target)

If Not rng Is Nothing Then
For Each cel In rng
x = 0
With cel
If .Column = 9 Then 'col I

If .Value = "" Then
x = xlNone
Else
x = .Offset(0, -4).Interior.ColorIndex 'col B
End If
If .Interior.ColorIndex < x Then
.Interior.ColorIndex = x
End If

With .Resize(1, 14)
v = .Interior.ColorIndex
If IsNull(v) Then v = -1
If v < x Then
.Interior.ColorIndex = x
End If
End With
End If

If x Then
End If
End With
Next
End If
errExit:
End Sub

Regards
D Dawson

Worksheet Change Event - Colour infill cells
 

below the line

Set rng = Intersect(Range(Range("I1"), _
Cells(Range("I500").End(xlUp).Row, 7)), Target)


add the line

rng.interior.ColorIndex = xlNone

--
Regards,
Tom Ogilvy


"dd" wrote:

Hi,

I'm using the following to highlight some cells in my row if the cell in
column 9 contains data.
How do I remove the colour if/when the data is then deleted?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long, v As Variant
Dim cel As Range
Dim rng As Range
On Error GoTo errExit

Set rng = Intersect(Range(Range("I1"), _
Cells(Range("I500").End(xlUp).Row, 7)), Target)

If Not rng Is Nothing Then
For Each cel In rng
x = 0
With cel
If .Column = 9 Then 'col I

If .Value = "" Then
x = xlNone
Else
x = .Offset(0, -4).Interior.ColorIndex 'col B
End If
If .Interior.ColorIndex < x Then
.Interior.ColorIndex = x
End If

With .Resize(1, 14)
v = .Interior.ColorIndex
If IsNull(v) Then v = -1
If v < x Then
.Interior.ColorIndex = x
End If
End With
End If

If x Then
End If
End With
Next
End If
errExit:
End Sub

Regards
D Dawson