How to Cell Updates Based on Worksheet Change in Corresponding Row

How to create VBA code to update cell based on worksheet change in corresponding row

Requirement:

The user has written some basic code that updates a cell based on a Worksheet_Change event in a corresponding row.

The Code below roughly works but sometimes crashes Excel or takes a few seconds to complete which suggests it's looping or something!

The code logic is as follows:

If A1 changes to = 1 Then Unlock B1 and clear formula contents.

If A1 changes to <> 1 Then Copy/Paste E1 (CellFormula) to B1 and Lock B1 cells.

The user is working with the code below:

Code:

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


    Dim Toggle As Range
    Dim Cell As Range
    Dim CellFormula As Range
    
    With Target
    Set Toggle = Range("a" & .Row)
    Set Cell = Range("b" & .Row)
    Set CellFormula = Range("CellFormula")
               
    If Toggle = 1 Then
    Cell.Locked = False
    Cell.Clear
    
    Else
    
    CellFormula.Copy
    Cell.Select
    Selection.PasteSpecial Paste:=xlPasteFormulas
    
    Application.CutCopyMode = False
    
    Cell.Locked = True
    
    End If
        
    End With
        
Errorline:

End Sub

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/148228-cell-updates-based-on-worksheet-change-in-corresponding-row

Solution:

Since you are dealing with an event macro ... there is a need to be precise as to what is the actual Source range ... and the Destination range ...

For example. should you need the whole of Column A to be the Source range ... you could test

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Column <> 1 Then Exit Sub
     
    Application.EnableEvents = False
    On Error GoTo Errorline
     
    Select Case Target
    Case 1
        Range("B" & Target.Row).Locked = False
        Range("B" & Target.Row).ClearContents
    Case Is <> 1
        Range("E" & Target.Row).Copy
        Range("B" & Target.Row).PasteSpecial Paste:=xlPasteFormulas
        Range("B" & Target.Row).Locked = True
    End Select
     
Errorline:
    Application.EnableEvents = True
     
End Sub

Obtained from the OzGrid Help Forum.

Solution provided by Carim.