How to clear cells in a column based on one cell being changed?

user_18270387 0
Viewed 39

I know how to clear one cell based on another cell being changed.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("K2")) Is Nothing Then
        Range("L2").ClearContents
    End If
End Sub

I want this to pertain all the way down each column.
If "K3" is changed, clear "L3", but not "L2" or any other cell not pertaining to that row change.

vba excel
3 Answers

Use Offset property.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("K:K")) Is Nothing Then
        target.offset(,1).ClearContents
    End If
End Sub
user_70080440

Try the following.
Target.Offset(0, 1) will clear the cell to the left of the modified cell.

If Not Intersect(Target, Range("K:K")) Is Nothing Then
    Target.Offset(0, 1).ClearContents
End If

If the user modifies more than one cell at once (eg with Copy&Paste), you might want to check every single cell. And as you modify a cell from the same worksheet, you should switch off Event handling while your code is running - else your modification will trigger another call of your Change-Routine

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    On Error Goto Change_Exit
    Dim cell As Range
    
    For Each cell In Target
        If Not Intersect(cell, Range("K:K")) Is Nothing Then
            cell.Offset(0, 1).ClearContents
        End If
    Next

Change_Exit:
    Application.EnableEvents = True
End Sub
user_75997980

A Worksheet Change: ClearContents

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    On Error GoTo ClearError ' enable error handling
    
    Const sfcAddress As String = "K2"
    Const dCol As String = "L"
    
    ' Reference the column range (exclude above the first cell (header(s)))
    Dim scrg As Range
    With Range(sfcAddress)
        Set scrg = .Resize(.Worksheet.Rows.Count - .Row + 1)
    End With

    ' Reference the intersecting range.
    Dim srg As Range: Set srg = Intersect(scrg, Target)
    If srg Is Nothing Then Exit Sub
    
    Dim drg As Range
    Dim sarg As Range ' copy/pasted multiple areas are only possible via VBA
    
    ' Combine the areas into a range.
    For Each sarg In srg.Areas
        If drg Is Nothing Then Set drg = sarg Else Set drg = Union(drg, sarg)
    Next sarg

    ' 'drg' can't be 'Nothing' since 'srg' is already 'something'.
    'If drg Is Nothing Then Exit Sub
    
     ' Prevent retriggering this or triggering any other event.
    Application.EnableEvents = False
    
    Intersect(drg.EntireRow, Columns(dCol)).ClearContents
        
SafeExit:
    On Error Resume Next ' defer error handling; prevent endless loop if error
        ' Enable events if they were disabled.
        If Not Application.EnableEvents Then Application.EnableEvents = True
    On Error GoTo 0 ' disable error handling
    
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit
End Sub


Sub MultiRangeTest()
    Range("K2:K10,K16:K20").Value = "Test"
End Sub
user_98140690
Related