Macro : Prevent Delete in a Cell or Multiple Cells

[muhammad susanto]

hi all...

i have macro code to prevent delete in a cell..
this code :

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


    Application.EnableEvents = False


    If Not Intersect(Target, Range("A2:A5,B2:B5")) Is Nothing Then
        If Len(Trim(Target.Value)) = 0 Then Application.Undo
    End If


LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

that's code is working but if i select in multiple cell e.g. drag / block from A2 to A5 then Press Del , the macro can't working, show "Type mismatch" then cell is deleted...

how to still keep or prevent the data can't delete when i delete for each cell or multiple cell...

thanks in advance...

m.susanto

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    If Intersect(Target, Range("A2:A5,B2:B5")) Is Nothing Then Exit Sub
    For Each rng In Target
        If Len(Trim(rng.Value)) = 0 Then Application.Undo
    Next rng
End Sub

 

[muhammad susanto]

hi mumps..you're always coming, worked it!!!
thank you...

 

[footoo]

hi mumps..you're always coming, worked it!!!
thank you...

Are you sure?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cel As Range
Set rng = Intersect(Target, Range("A2:A5,B2:B5"))
If Not rng Is Nothing Then
    For Each cel In rng
        If Len(Trim(cel)) = 0 Then
            With Application
                .EnableEvents = False
                .Undo
                .EnableEvents = True
            End With
            Exit Sub
        End If
    Next
End If
End Sub