On Cell Change program suddenly stopped working VBA - vba

Question

Edit: Making this way simpler.
Edit2: Changed Target.Application to Application
The following code should detect a change in any cell in column A, and change the value of the adjacent cell in column B to "Success".
This was working, and now it isn't.
Sub Worksheet_Change(ByVal Target As Range)
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If Not Intersect(ActiveCell, Range("A:A")) Is Nothing Then
ActiveCell.Offset(0, 1).Value = "Success"
End If
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Answer 1

Should look more like this:
Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
Set rng = Application.Intersect(Target, Me.Range("A:A"))
If Not rng Is Nothing Then
On Error GoTo haveError 'turn on error handling
Application.EnableEvents = False
For Each c In rng.Cells 'need to handle a multi-cell update
c.Offset(0, 1).Value = "Success"
Next c
Application.EnableEvents = True
End If
Exit Sub 'normal exit
haveError:
MsgBox Err.Description
Application.EnableEvents = True 'ensure events aren't left turned off
End Sub