Reputation: 103
I have the following vba code that works exactly as expected, except for one thing.
so this is set into a tracking worksheet. the purpose of the worksheet is to determine whether something is done or not with 1's and 0's, and then figures the percentage complete... blah blah blah.
so when the user enters 1 on the sheet (within the range) it changes the interior and font color to green. if the user enters 0 it changes the interior and font color to red.
if the user hit's delete on a cell that has always been empty (never had anything data entered into it) the code works as expected. but if user hit's delete on a cell that has had data entered into it reverts that value back to "0" and the cell turns red.
i need the code to go into the last else statement when the user hits delete within the range (or backspace for that matter). any suggestions would be greatly appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim inRange As Range
Set inRange = Intersect(Target, Range("C3:N13"))
If (Not (inRange Is Nothing)) Then
If IsEmpty(Target) = False Then
With Target.FormatConditions.Add(xlCellValue, xlEqual, "=0")
.Interior.Color = 255
.Font.Color = 255
End With
With Target.FormatConditions.Add(xlCellValue, xlGreater, 0)
.Interior.Color = -11489280
.Font.Color = -11489280
End With
Else
With Target.Borders
.LineStyle = xlContinuous
.Weight = xlThin
End With
If Target.Row Mod 2 = 0 Then
With Target.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
With Target.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End If
End If
End If
End Sub
Upvotes: 0
Views: 96
Reputation: 10715
Try this
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Cells.CountLarge = 1 Then 'continue only if one cell was edited (copy/paste)
If Not Intersect(Target, Me.Range("C3:N13")) Is Nothing Then 'is within range
Application.EnableEvents = False
If Len(Trim$(.Value2)) > 0 Then 'not deletion
If .Value2 <> 1 Then .Value2 = 0 'not 0 or 1
Dim clr As Long
clr = IIf(.Value2 = 0, vbRed, RGB(0, 176, 80)) 'red (or green if 1)
.Interior.Color = clr
.Font.Color = clr
Else 'deletion (Del, Backspace, Space keys, or pastes empty string)
On Error Resume Next 'expected error: Nothing to Undo
Application.Undo 'determine previous value
On Error GoTo 0
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
If Len(Trim$(.Value2)) > 0 Then 'if previous val was not empty
Target.Value2 = 0
.Interior.Color = vbRed
.Font.Color = vbRed
End If
End If
Application.EnableEvents = True
End If
End If
End With
End Sub
If only one cell was updated, and is within the range
1
(and only a value of 1
is accepted) - cell becomes GreenApplication.Undo
(expect error - Nothing to Undo)
Note: If you use formulas, it should check for cells with errors (If Nor IsError(Target) Then
)
As noted in the comments, your code keeps duplicating conditional formatting rules (without removing them first). The file will become bloated over time, and they are not really needed anyway
Upvotes: 1