0

I have 2 columns in my excel sheet which I want to have protected in a way that you can't delete the cell nor its content. I don't want to use the built in sheet protection, instead I want to use VBA (because of no password needed). I found some code which should prevent cells from being deleted, but it doesn't work. Also I have no idea how VBA works and therefore I would be happy if someone can either provide a solution or guide me on how to do it myself.

The code I found is this:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A6:B1048576")) Is Nothing Then Exit Sub
    On Error GoTo ExitPoint
    Application.EnableEvents = False
    If Not IsDate(Target(1)) Then
        Application.Undo
    End If
ExitPoint:
    Application.EnableEvents = True
End Sub
3
  • Why don't you want to use sheet protection?
    – Selkie
    Sep 15, 2017 at 17:29
  • The Worksheet Change function is only useful if the select one cell. If they select a range of cells, it will error and quit. Sheet protection would be better as you can prevent them from selecting the cell in the first place
    – DavePenn
    Sep 15, 2017 at 20:55
  • I don't want to prevent them the cell from editing. I only want to prevent the users from either deleting the entire cell or removing the entry (no content in the cell) Sep 18, 2017 at 6:08

1 Answer 1

1

This is similar to the code in your question, but prevents any cell in columns A:B being deleted / set to blank:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Dim b As Boolean

    On Error GoTo Terminate

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    For Each c In Target.Cells
        If Not Intersect(c, Range("A:B")) Is Nothing And c.Value = "" Then
            b = True
            GoTo UndoChange
        End If
    Next c

UndoChange:
    If b Then Application.Undo

Terminate:
    If Err Then
        Debug.Print "Error", Err.Number, Err.Description
        Err.Clear
    End If

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

It works with multiple cell selections, as it loops through each cell in the changed range, and checks for a blank value.

EDIT: Amended code, to integrate your existing Worksheet_Change functionality;

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Dim b As Boolean

    On Error GoTo Terminate

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    For Each c In Target.Cells
        If Not Intersect(c, Range("A:B")) Is Nothing And c.Value = "" Then
            b = True
            GoTo UndoChange
        End If
        If c.Column = 10 And c.Row >= 6 Then
            c.Value = UCase(c.Value)
        End If
    Next c

UndoChange:
    If b Then Application.Undo

Terminate:
    If Err Then
        Debug.Print "Error", Err.Number, Err.Description
        Err.Clear
    End If

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
11
  • but they are still editable? Sep 18, 2017 at 9:26
  • Yes. Have you tried it?
    – Olly
    Sep 18, 2017 at 9:27
  • Can it be that its not possible to have 2 Worksheet_Change subs for the same sheet? Sep 18, 2017 at 9:29
  • No, you can't. Replace your existing code with the code I posted.
    – Olly
    Sep 18, 2017 at 9:30
  • Well, thats not possible. I would have to merge the code as its other code i need. Sep 18, 2017 at 9:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.