• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Custom Format

P

paulstan

New Member
I need a column to accept one of the following entries only:


be left blank

date (in dd/mm/yyyy) format

or the word 'Validated'


If anything else is input, then an error message is displayed.


I have attached the code. Unfortunately, my problem lies when you type in a valid date, leave the cell and then return to it, the date automatically changes to its numerical value; for example: 15/07/2011 is showing as 40793.


Is there an easier way of formatting the Column?


Regards


Paul S

Tested in Excel 2007

[pre]
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range, CellText As String
If Not Intersect(Target, Columns("A")) Is Nothing Then
For Each Cell In Target
CellText = UCase(Cell.Text)
If Len(CellText) = 0 Then Exit Sub
If CellText = "VALIDATED" Then
Application.EnableEvents = False
Cell.Value = "Validated"
Application.EnableEvents = True
Exit Sub
ElseIf IsDate(CellText) And CellText Like "*[!0-9]*" Then
Application.EnableEvents = False
Cell.Value = CDate(CellText)
Application.EnableEvents = True
Cell.NumberFormat = "dd/mm/yyyy"
Exit Sub
End If
MsgBox "Invalid Entry!" & vbCr & "Please enter one of the following: " & vbCrLf & vbCrLf & "type the text 'validated'" & vbCr & "date (in dd/mm/yyyy format)" & vbCr & "leave blank"
Target.Select
Next
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cell As Range
If Not Intersect(Target, Columns("A")) Is Nothing Then
For Each Cell In Target
Target.NumberFormat = "General"
Next
End If
End Sub
[/pre]
 
Change the Worksheet_SelectionChange procedure as below

[pre]
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cell As Range
If Not Intersect(Target, Columns("A")) Is Nothing Then
For Each Cell In Target
Target.NumberFormat = "dd/mm/yyyy"
Next
End If
End Sub
[/pre]
 
Hi Hui


Thanks for your reply. Yes, I did try that one as well but you can revisit a cell with a date and overtype with any number and get the numerical date value, which is not what I require. For example typing 555 into a cell that contained the date 18/07/2011 will result in that date changing to 08/07/1901. This is only a problem if there is a valid date in the cell and you enter any number format. Typing non-valid text (other than the word 'validated') into a cell will yield an error message which is correct.


Regards


Paul S
 
Paul

Tricky one, especially as numbers are quite valid dates


Do you have a low range of dates you could use in the VBA validation process ie: 1/1/1980?

That way you could check if it was either Validated or > 29,221 etc
 
Hi Hui


Thanks for the reply. Yes, there would more than likely be a low range of dates, say 1/1/2000 and an upper range not to exceed the current system date.


Regards


Paul S
 
You could change the line


Code: 
ElseIf IsDate(CellText) And CellText Like "*[!0-9]*" Then


to

ElseIf IsDate(CellText) And CellText Like "*[!0-9]*" And DateSerial(Year(CellText), Month(CellText), Day(CellText)) >= DateSerial(2000, 1, 1) Then
 
Hi Hui


That nearly works. The problem now is if I try to enter any text I get a runtime error 13 'Type Mismatch', pointing to line:
Code: 
ElseIf IsDate(CellText)...


And here was me thinking it would be just a simple custom format!!!


Regards


Paul S
 
Time for an error handler:

[pre]
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range, CellText As String
If Not Intersect(Target, Columns("A")) Is Nothing Then
For Each Cell In Target
CellText = UCase(Cell.Text)
If Len(CellText) = 0 Then Exit Sub
On Error GoTo ErrMsg
If CellText = "VALIDATED" Then
Application.EnableEvents = False
Cell.Value = "Validated"
Application.EnableEvents = True
Exit Sub
ElseIf IsDate(CellText) And CellText Like "*[!0-9]*" And DateSerial(Year(CellText), Month(CellText), Day(CellText)) >= DateSerial(2000, 1, 1) Then
Application.EnableEvents = False
Cell.Value = CDate(CellText)
Application.EnableEvents = True
Cell.NumberFormat = "dd/mm/yyyy"
Exit Sub
End If
ErrMsg: MsgBox "Invalid Entry!" & vbCr & "Please enter one of the following: " & vbCrLf & vbCrLf & "type the text 'validated'" & vbCr & "date (in dd/mm/yyyy format)" & vbCr & "leave blank"
Target.Select
Next
End If
End Sub
[/pre]
 
Hui


That is brilliant and nigh perfect. For final 'tweaking' purposes, is there a way to limit the date to no greater than today (system's today day!!)?


Many, many thanks for your help on this.


Regards


Paul S
 
Looks like you can change Hui's line of:

Code: 
ElseIf IsDate(CellText) And CellText Like "*[!0-9]*" And DateSerial(Year(CellText), Month(CellText), Day(CellText)) >= DateSerial(2000, 1, 1) Then



To this:



ElseIf IsDate(CellText) And CellText Like "*[!0-9]*" And DateSerial(Year(CellText), Month(CellText), Day(CellText)) >= DateSerial(2000, 1, 1) And DateSerial(Year(CellText), Month(CellText), Day(CellText))<= Date Then
 
Hui & Luke M


Now it is perfect! Can't thank you enough for your most generous help.


Lets hope I can now start to understand VB a little more.


Regards


Paul S
 
You must log in or register to reply here.
Back
Top