简体   繁体   中英

How To Clear Contents of A Cell If Another Cell Changes In Vba

I am extremely new to vba, I have a column A in sheet 1 and column B in sheet 2. I want if a cell in column A sheet 1 changes, then a cell in column B sheet 2 should change also.

Private Sub Worksheet_Change (ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Sheets("Sheet2").Range("B:B").ClearContents
End If
End Sub

I have tried this but it just clears the whole column.

Any help will be appreciated.

One of these should do the trick:

Option Explicit
'
' If cell is edited in any way
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 And Not Intersect(Target, Range("A:A")) Is Nothing Then
    Sheets("Sheet2").Range("B" & Target.Row).ClearContents
    End If
End Sub
'
' If cell is cleared
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Value = "" And Target.Cells.Count = 1 And Not Intersect(Target, Range("A:A")) Is Nothing Then
    Sheets("Sheet2").Range("B" & Target.Row).ClearContents
    End If
End Sub

A Worksheet Change: Clear Contents in Another Worksheet

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const SOURCE_COLUMN As String = "A"
    Const DESTINATION_NAME As String = "Sheet2"
    Const DESTINATION_COLUMN As String = "B"

    Dim dws As Worksheet, srg As Range, ColumnOffset As Long
    
    With Me
        Set srg = Intersect(Target, .Columns(SOURCE_COLUMN))
        If srg Is Nothing Then Exit Sub
        ColumnOffset = .Columns(DESTINATION_COLUMN).Column _
            - .Columns(SOURCE_COLUMN).Column
        Set dws = .Parent.Worksheets(DESTINATION_NAME)
    End With

    Dim durg As Range, drg As Range, sarg As Range
    
    For Each sarg In srg.Offset(, ColumnOffset).Areas
        Set drg = dws.Range(sarg.Address)
        If durg Is Nothing Then Set durg = drg Else Set durg = Union(durg, drg)
    Next sarg

    If Not durg Is Nothing Then durg.ClearContents

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM