如果单元格 A 为空，则清除 B 到 F 列的内容

Question

I have a worksheet with values depending on Cell A. If a row in column A contains a value then cells from Columns B through H will be changed accordingly.

If Cell of Column A is empty I want to reset the cells from columns D through F.

I wrote down the following VBA Code

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim n As Integer
    For n = 5 To 75
        Application.EnableEvents = False
        If VarType(Cells(n, 1)) = vbEmpty Then
           Cells(n, 4).ClearContents
           Cells(n, 5).ClearContents
           Cells(n, 6).ClearContents
        Application.EnableEvents = True
        End If
    Next n
End Sub

The "FOR" Loop is annoying, and making the Excel to pause for 1 second or more after any entry to any Cell, can anyone help me correct the above code to do what I need to do without the "FOR" loop.

Answer 1

You are using a Worksheet_Change event and you iterating through 70 rows each time something changes.. this is a bad approach for this kind of problem and that's why there is a delay.

Instead, try

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim n As Long

    If Target.Column = 1 Then
        If IsEmpty(Cells(Target.Row, 1)) Then
               Range("B" & Target.Row & ":F" & Target.Row).ClearContents
        End If
    End If
End Sub

this will only clear the cells if you remove a value from column A => when cell in column A is empty

Answer 2

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
If Mid(Target.Address(1, 1), 1, 2) = "$A" Then
    If Target.Cells(1, 1).Value = "" Then
        For i = 4 To 6
            Target.Cells(1, i).Value = ""
        Next i
    End If
End If
End Sub

Answer 3

Give this a try:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rLook As Range, r As Range, Intr As Range
    Set rLook = Range("A5:A75")
    Set Intr = Intersect(rLook, Target)
    If Intr Is Nothing Then Exit Sub
    Application.EnableEvents = False
        For Each r In Intr
            If r.Value = "" Then
                rw = r.Row
                Range("D" & rw & ":F" & rw).ClearContents
            End If
        Next r
    Application.EnableEvents = True
End Sub

It should have minimal impact on timing.

Answer 4

Use a range object. The following line of code will print the address of the Range we'll use to clear the contents. The first cells call gets the upper left corner of the range, the second cells call gets the lower right corner of the range.

Private Sub test()
    Debug.Print Range(Cells(5, 4), Cells(75, 6)).Address
End Sub

We apply this to your code like this:

Private Sub Worksheet_Change(ByVal Target As Range)
    If VarType(Cells(Target.Row, 1)) = vbEmpty Then
        Application.EnableEvents = False
        Range(Cells(Target.Row, 4), Cells(Target.Row, 6)).ClearContents
        Application.EnableEvents = True
    End If
End Sub

One final sidenote: You should use an error handler to make sure events are always enabled when the sub exits, even if an error occurs.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrHandler

    If VarType(Cells(Target.Row, 1)) = vbEmpty Then
        Application.EnableEvents = False
        Range(Cells(Target.Row, 4), Cells(Target.Row, 6)).ClearContents
    End If
ExitSub:
    Application.EnableEvents = True
    Exit Sub
ErrHandler:
    MsgBox "Oh Noes!", vbCritical
    Resume ExitSub
End Sub

Answer 5

You should disable events and cater for multiple cells when using the Change event.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Intersect(Columns("A"), Target)
If rng1 Is Nothing Then Exit Sub

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

For Each rng2 In rng1.Cells
If IsEmpty(rng2.Value) Then rng2.Offset(0, 1).Resize(1, 5).ClearContents
Next

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub

Answer 6

For those that need to have data entered in one cell cleared (in a column) when there's a change in another column use this, which is a modification of Gary's Student.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rLook As Range, r As Range, Intr As Range
Set rLook = Range("D:D")
Set Intr = Intersect(rLook, Target)
If Intr Is Nothing Then Exit Sub
Application.EnableEvents = False
    For Each r In Intr
        If r.Value = "" Then
            rw = r.Row
            Range("L:L").ClearContents
        End If
    Next r
Application.EnableEvents = True

End Sub