0
votes

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
1
It sounds like you need to delete any format conditions at the beginning of that Else statement.BigBen
Why not use select case to be a little more direct? Select Case Target.Value Case 0 blah, Case 1 blah, Case "", End Select.Cyril

1 Answers

1
votes

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

  • Stop all events from firing
  • If user didn't delete
    • If user enter a 1 (and only a value of 1 is accepted) - cell becomes Green
    • If 0, or any other number or letter is entered - cell becomes red, with value 0
  • If user deletes the target cell (Del, Backspace, Space keys, or pastes empty string)
    • Show borders (first-time edit)
    • Determine previous value with Application.Undo (expect error - Nothing to Undo)
      • If previous was empty - no change: cell left empty, without a color)
      • If previous not empty: cell becomes 0, color and font become Red
  • Turn events back on

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