VBA force only date format in a certain cell on a certain sheet

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
871
Office Version
  1. 365
Platform
  1. Windows
Hello,

I am trying to have a certain cell locked (B2) that only a certain date format can be entered but I keep getting an error with the code. Perhaps you can shed some light on what I am doing wrong? Still very new to this.

Thank you

Code:
Private Sub Worksheet_Change()

    Call ValidateDate(2) 'For Column B2:B2




End Sub




Private Sub ValidateDate()


    Set r = ActiveSheet.Range(Cells(2, Col), Cells(2, Col))
    For Each c In r
        If c.Value <> "" And Not IsDate(c) Then
            c.ClearContents
            MsgBox "Please enter Date Returned in the following format: MM/DD/YYYY"
        End If
    Next c
ActiveSheet.Range("B2:B2").NumberFormat = "[$-409]d-mmm-yy;@"
End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
A few things.

1. Why are you trying to pass a parameter of 2 when the procedure does not accept any arguments?
Code:
Call ValidateDate([COLOR=#ff0000][B]2[/B][/COLOR])
Code:
Private Sub ValidateDate()

2. If you want to limit this to changes to cell B2 only, then you should use:
Code:
Private Sub Worksheet_Change()

   'For Column B2:B2
    If Intersect(Target, Range("B2")) Is Nothing Then
        Exit Sub
    Else
        Call ValidateDate() 'For Column B2:B2
    End If

End Sub
Then in your ValidateDate code, you don't need to loop through anything, as you only want to check cell B2.
 
Upvote 0
I actually went through and updated everything, and made it more generic so it can easily be re-used for any range.
Try this variation:
Code:
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    
'   Set range you want to apply this to
    Set rng = Range("B2")
    
'   Check to see if update is made to designated range
    If Intersect(Target, rng) Is Nothing Then
        Exit Sub
    Else
        Call ValidateDate(rng)
    End If

End Sub


Private Sub ValidateDate(r As Range)

    Dim c As Range

    For Each c In r
        If c.Value <> "" And Not IsDate(c) Then
            Application.EnableEvents = False
            c.ClearContents
            MsgBox "Please enter Date Returned in the following format: MM/DD/YYYY"
            c.NumberFormat = "[$-409]d-mmm-yy;@"
            Application.EnableEvents = True
        End If
    Next c

End Sub
 
Last edited:
Upvote 0
I get a number format is out of range error for: c.NumberFormat = "[$-409]d-mmm-yy;@"
 
Upvote 0
Ok, let's move it back out to where it was before, and let's change it to a format matching what your code is asking for (don't know why you had that different in the first place):
Code:
Private Sub ValidateDate(r As Range)

    Dim c As Range

    For Each c In r
        If c.Value <> "" And Not IsDate(c) Then
            Application.EnableEvents = False
            c.ClearContents
            MsgBox "Please enter Date Returned in the following format: MM/DD/YYYY"
            Application.EnableEvents = True
        End If
    Next c

    r.NumberFormat = "mm/dd/yyyy"

End Sub
 
Upvote 0
I find the code doesn't work now. I enter in a letter in cell B2 and nothing happens.
 
Upvote 0
I find the code doesn't work now. I enter in a letter in cell B2 and nothing happens.
It is because your code was previously interrupted, where the this line ran:
Code:
Application.EnableEvents = False
and this line didn't:
Code:
Application.EnableEvents = True

"Events" are things that happen that trigger automatic code (like "Worksheet_Change") to run. When we want our automated code to make updates to the worksheet, we often temporarily disable those events, so that the code doesn't call itself and get caught in an infinite loop. But we need to turn it back on after the changes so the events are enabled again. Because you had that error, it never got to that last line.

We can turn it back on by manually running this code:
Code:
Private Sub FixIt()
    Application.EnableEvents = True
Exit Sub
Do that, and the code should work again.
 
Upvote 0
I am very new to this but I have tried to have it run at the beginning of the code you gave me and I tried to manually run it in a macro and I get expected End Sub error.
I had this working originally when it referenced a column but I just wanted it to be changed to 1 cell. The original code I was using is below but now nothing seems to be working.

Code:
[COLOR=#333333]Private Sub Worksheet_Change()[/COLOR]
    Call ValidateDate(2) 'For Column B2:B2000




End Sub




Private Sub ValidateDate()


    Set r = ActiveSheet.Range(Cells(2, Col), Cells(2000, Col))
    For Each c In r
        If c.Value <> "" And Not IsDate(c) Then
            c.ClearContents
            MsgBox "Please enter Date Returned in the following format: MM/DD/YYYY"
        End If
    Next c
ActiveSheet.Range("B2", "B2000").NumberFormat = "[$-409]d-mmm-yy;@" [COLOR=#333333]End Sub[/COLOR]
 
Upvote 0
I finally got it to work. Needed an End Sub not an Exit Sub to re-activate. Now that that is turned back on it appears to be working.

My boss did want the date to be automatically formated as: [$-409]d-mmm-yy;@ however but I will manually do this.

Thank you for your help
 
Last edited:
Upvote 0
The code I gave you should do what you want.
If you want to try working with that, I will help you, but if you are going to go back to your original code, I am out.

So this:
1. Close down Excel altogether. This will reset everything.
2. Go back into Excel and open your Workbook.
3. Get rid of your old code, and paste the Code that I gave you there (BE ABSOLUTELY SURE THAT YOU ARE PUTTING THIS CODE IN THE CORRECT PLACE, IT NEEDS TO BE IN THE PROPER SHEET MODULE).
4. Try making a change to cell B2 and see what happens.
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,255
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top