Prevent Cell Deletion - Data Validation

[meridius10]

I have set up a Data Validation List and an Error Alert of 'Stop'.

The spreadsheet has been set up with Protection, locked cells and columns, where necessary.

What I'm looking for is to prevent users deleting any of these particular cells although, of course, they can choose from what is in the data validation list.

 

[Jaafar Tribak]

Put this code in the worksheet module :

Option Explicit

Private Declare Sub keybd_event Lib "user32.dll" _
(ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const KEYEVENTF_KEYUP = &H2

Private Const VAL_RANGE As String = "A1" 'change this cell as required.
                                         
Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = Range(VAL_RANGE).Address Then
        If IsEmpty(Target) Then
            keybd_event vbKeySpace, 0, 0, 0
            keybd_event vbKeySpace, 0, KEYEVENTF_KEYUP, 0
            keybd_event vbKeyReturn, 0, 0, 0
            keybd_event vbKeyReturn, 0, KEYEVENTF_KEYUP, 0
            With Application
                .EnableEvents = False
                .Undo
                .EnableEvents = True
            End With
        End If
    End If

End Sub

The above assumes the cell with validation is A1 . Change the cell address Constante at the top of the code as needed.

 

[meridius10]

OK, but what if I have numerous ranges in multiple columns?

 

[jeffreybrown]

Here's a potential solution. Give it a test.

Start with a blank sheet
Highlight G1:G10
Press the = sign and enter 1
Confirm with Ctrl + Shift + Enter

If entered correctly you will see {=1} in G1:G10

Now try to delete a row.

In cell C3 enter some data validation.

Now try to delete that cell.

 

[meridius10]

Mmmm... I was hoping that there may be an easier way to do this...

 

[Jaafar Tribak]

OK, but what if I have numerous ranges in multiple columns?

Try this code in the worksheet module which works for a Range with multi-cells. In this case Range A1:D20. Change the range as required

Option Explicit

Private Declare Sub keybd_event Lib "user32.dll" _
(ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const KEYEVENTF_KEYUP = &H2

Private Const VAL_RANGE As String = "A1:D20" 'change this range as required.
                                         
Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range(VAL_RANGE)) Is Nothing Then
          If WorksheetFunction.Sum(Target) = 0 Then
            keybd_event vbKeySpace, 0, 0, 0
            keybd_event vbKeySpace, 0, KEYEVENTF_KEYUP, 0
            keybd_event vbKeyReturn, 0, 0, 0
            keybd_event vbKeyReturn, 0, KEYEVENTF_KEYUP, 0
            With Application
                .EnableEvents = False
                .Undo
                .EnableEvents = True
            End With
        End If
    End If

End Sub

 

[meridius10]

And multiple unconnected ranges / columns eg. Column A, Column C etc...