Help with modifying data

[RandyD123]

I am using the VBA below. I need it to do two things. One is if a user tries to "clear content" in column D, they should get a message box saying that they can't do that without first clearing their entry in column A. Second I noticed that if I select multiple entry's in column A and use the clear content, the info in column D does not clear. If I select just one entry it works fine, can this be fixed?

Private Sub Worksheet_Change(ByVal Target As Range)

 On Error GoTo Catch

 '// Prevent any changes firing this event again
 Application.EnableEvents = False

 '// Change the '1' to ignore any heading rows
1 If Target.Row > 1 Then

 '// Which column was changed?
Select Case Target.Column
'// A
Case 1
Target.Offset(, 3).Value = IIf(Len(Target.Value), "Changed By " & Environ("UserName") & " on " & Date & " @ " & Time, "")
Case 4
'// Prevent user changes to Col D
Application.Undo
Beep
 End Select

 End If

Catch:

 '// Make sure event handling turned on again
 Application.EnableEvents = True

End Sub

If anyone can help, thank you for your time.

 

[Yongle]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
'variables used
    Dim colA As Range, colD As Range, Cel As Range
'set ranges as required
    Set colA = Range("A2").Resize(Rows.Count - 1)
    Set colD = colA.Offset(, 3)
'cells amended that are in required ranges
    Set colA = Intersect(colA, Target)
    Set colD = Intersect(colD, Target)
'ensure events are ALWAYS switched back on
    On Error GoTo Catch
    Application.EnableEvents = False
'Prevent user changes to Col D
    If Not colD Is Nothing Then
        Application.Undo
        Beep
    End If
'loop all changed cells in column A and amend corresponding cell in column D
    If Not colA Is Nothing Then
        For Each Cel In colA
            Cel.Offset(, 3).Value = IIf(Len(Cel.Value), "Changed By " & Environ("UserName") & " on " & Date & " @ " & Time, "")
        Next Cel
    End If

Catch:
'ensure event handling turned on again
    Application.EnableEvents = True
End Sub

 

[RandyD123]

The only thing that it doesn't do is give an error msg box when the user tries to clear column D without first clearing column A. As far as I can tell, it does EVERYTHING else I asked for!!!

 

[RandyD123]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
'variables used
    Dim colA As Range, colD As Range, Cel As Range
'set ranges as required
    Set colA = Range("A2").Resize(Rows.Count - 1)
    Set colD = colA.Offset(, 3)
'cells amended that are in required ranges
    Set colA = Intersect(colA, Target)
    Set colD = Intersect(colD, Target)
'ensure events are ALWAYS switched back on
    On Error GoTo Catch
    Application.EnableEvents = False
'Prevent user changes to Col D
    If Not colD Is Nothing Then
        Application.Undo
        Beep
    End If
'loop all changed cells in column A and amend corresponding cell in column D
    If Not colA Is Nothing Then
        For Each Cel In colA
            Cel.Offset(, 3).Value = IIf(Len(Cel.Value), "Changed By " & Environ("UserName") & " on " & Date & " @ " & Time, "")
        Next Cel
    End If

Catch:
'ensure event handling turned on again
    Application.EnableEvents = True
End Sub

I think I like it like it is though!! Thank You Very Much. Works Perfectly!!!

 

[Yongle]

Amend this bit

    If Not colD Is Nothing Then
        Application.Undo
        Beep
        MsgBox "Can't do that",,""
    End If