Using SheetChange Events with validation

[herbwarri0r]

I have created the code below so that once a value is entered any of four columns the cell becomes locked.

The problem I have is that the cells also have validation to only allow dates. Yet now I am using this code it will allow other values.

EDIT: Sorry without the If statement it would allow any other values.

I'd like to know the technicalities of why this is happening and also if my workaround is ok.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
Select Case Target.Column
 
Case Is = 6, 7, 10, 11
    ThisWorkbook.ActiveSheet.Unprotect Password:="armoured"
    Target.Locked = True
    ThisWorkbook.ActiveSheet.Protect Password:="armoured"
    
    If Target.Value Like "##/##/####" Then
        Exit Sub
        Else
        ThisWorkbook.ActiveSheet.Unprotect Password:="armoured"
        Target.Value = ""
    End If
    
End Select
End Sub

[Bob Phillips]

I don't know what you are trying to do or what is wrong, but that code needs a serious overhaul

[vba]
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Application.EnableEvents = False

Select Case Target.Column

Case Is = 6, 7, 10, 11

Sh.Unprotect Password:="armoured"
Target.Locked = True
Sh.Protect Password:="armoured"

If Not Target.Value Like "##/##/####" Then

Sh.Unprotect Password:="armoured"
Target.Value = ""
End If
End Select

Application.EnableEvents = True
End Sub
[/vba]

[herbwarri0r]

Ok, say you put some validation on column A to only allow dates using the GUI and you have the code below in ThisWorkbook.

Type something that's not a date in A1, the data validation input box pops up saying that's not allowed. Yet the value you tried to type does get accepted.

I just wanted to know why that was and if adding the If statement is the right way to go about fixing it.

[vba]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Application.EnableEvents = False

Select Case Target.Column

Case Is = 1

Sh.Unprotect Password:="armoured"
Target.Locked = True
Sh.Protect Password:="armoured"
End Select

Application.EnableEvents = True
End Sub[/vba]

[Bob Phillips]

Not for me it didn't. I typed in abc, got the message and it reverted. But the protection in that latest code seems about face. What is this code supposed to achieve?

[herbwarri0r]

I realise now that in the Erorr Alert for the data validation I was using the information style instead of stop.

With the help of a colleague I've added some error handling and some exceptions.

The code will allow users to enter dates in two columns, have the adjacent cell populate with todays date and then lock all the date cells.


[VBA]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

On Error GoTo err:
Debug.Print Selection.Cells.Count
If Selection.Cells.Count > 1 Then
Target.Value = ""
Exit Sub
End If
If Target.Worksheet.Name = "Drop Down Menues" Then Exit Sub
If Target.Value = "" Then Exit Sub
If DateValue(Target.Text) > Date Then
MsgBox "no future dates"
Target.Value = ""
Target.Select
Exit Sub
End If
Select Case Target.Column
Case Is = 6, 10
Sh.Unprotect Password:="armoured"
Target.Offset(0, 1).Value = Date
Target.Locked = True
Target.Offset(0, 1).Locked = True
Sh.Protect Password:="armoured"
End Select

If Target.Value Like "##/##/####" Then
Exit Sub
Else
Application.EnableEvents = False
Sh.Unprotect Password:="armoured"
Target.Value = ""
Target.Offset(0, 1).Value = ""
Target.Select
Application.EnableEvents = True
End If

'Application.EnableEvents = True
Exit Sub

err:
Application.EnableEvents = False
Sh.Unprotect Password:="armoured"
MsgBox "Unrecognised date - please use format dd/mm/yy"
Target.Value = ""
Target.Offset(0, 1).Value = ""
Target.Select
Application.EnableEvents = True
End Sub
[/VBA]