Cells blocked with permission to change II (block full range)

[marreco]

Hi.

Way this code not work when i clear big range (work when i try clear one cell)

http://www.vbaexpress.com/forum/showthread.php?40357-Cells-blocked-with-permission-to-change&highlight=

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewValue As Variant, OldValue As Variant
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B6:EP18240")) Is Nothing Then
NewValue = Target.Value
Application.EnableEvents = False
Application.Undo
OldValue = Target.Value
If OldValue = "" Then
Target.Value = NewValue
ElseIf InputBox("Digite a senha") = "1" Then
Target.Value = NewValue
Else: MsgBox "Você não pode alterar o conteudo da celula.", 16, "Células Bloqueadas"
Target.Value = OldValue
End If
Application.EnableEvents = True
End If
End Sub



Thank you!!!

[Aussiebear]

Try placing an apostrophe in front on the line
if target.count >1 then exit sub and see what happens

[marreco]

i do, user can clear cells ( I can not afford it).

I need to prevent the user clear one or more cells in range B6:EP18240

[Aussiebear]

I had hoped others would have jumped in here but to me once you select a range greater than 1 cell the code exits the sub, hence my suggestion to comment out the line as suggested above

[Bob Phillips]

You could try locking them, or if not possible then


Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewValue As Variant, OldValue As Variant
If Not Intersect(Target, Range("B6:EP18240")) Is Nothing Then Exit Sub
NewValue = Target.Value
Application.EnableEvents = False
Application.Undo
OldValue = Target.Value
If OldValue = "" Then
Target.Value = NewValue
ElseIf InputBox("Digite a senha") = "1" Then
Target.Value = NewValue
Else: MsgBox "Você não pode alterar o conteudo da celula.", 16, "Células Bloqueadas"
Target.Value = OldValue
End If
Application.EnableEvents = True
End Sub

[marreco]

Hi xld
your code is allowing delete (clear) cells, I need to block the user to delete the cell contents.

[Aussiebear]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewValue As Variant, OldValue As Variant
If Not Intersect(Target, Range("B6:EP18240")) Is Nothing Then Exit Sub
If inputbox("Digite a senha") = "1" Then
Target.Value = NewValue
Else: MsgBox "Você não pode alterar o conteudo da celula.", 16, "Células Bloqueadas"
Target.Value = OldValue
End If
If OldValue = " " Then
Target.Value = NewValue
End If
End If
End Sub

[Jan Karel Pieterse]

The problem is that if multiple cells are cleared you cannot check against a string value:

If OldValue = "" Then

fails, because OldValue is now an array of values.

Try this:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewValue As Variant, OldValue As Variant
Dim lRow As Long
Dim lCol As Long
Dim bNoData As Boolean
If Not Intersect(Target, Range("B6:EP18240")) Is Nothing Then
NewValue = Target.Value
Application.EnableEvents = False
Application.Undo
OldValue = Target.Value
If IsArray(NewValue) Then
bNoData = True
For lRow = 1 To UBound(NewValue, 1)
For lCol = 1 To UBound(NewValue, 2)
If NewValue(lRow, lCol) <> "" Then
bNoData = False
Exit For
End If
Next
Next
If bNoData Then
'User cleared the range!
If InputBox("Digite a senha") = "1" Then
Target.Value = NewValue
Else: MsgBox "Você não pode alterar o conteudo da celula.", 16, "Células Bloqueadas"
Target.Value = OldValue
End If
Else
Target.Value = NewValue
End If
Else
If OldValue = "" Then
Target.Value = NewValue
ElseIf InputBox("Digite a senha") = "1" Then
Target.Value = NewValue
Else: MsgBox "Você não pode alterar o conteudo da celula.", 16, "Células Bloqueadas"
Target.Value = OldValue
End If
End If
End If
Application.EnableEvents = True
End Sub

[Aussiebear]

Phew...... not even within a hundred light years of the solution. Oh well back to the salt mines.

[marreco]

Hi JKP, vey good, work nice!

thank you very much!!!