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

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
554
Office Version
2019
Platform
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
 

Some videos you may like

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
53,642
Office Version
365
Platform
Windows
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.
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
53,642
Office Version
365
Platform
Windows
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:

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
554
Office Version
2019
Platform
Windows
I get a number format is out of range error for: c.NumberFormat = "[$-409]d-mmm-yy;@"
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
53,642
Office Version
365
Platform
Windows
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
 

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
554
Office Version
2019
Platform
Windows
I find the code doesn't work now. I enter in a letter in cell B2 and nothing happens.
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
53,642
Office Version
365
Platform
Windows
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.
 

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
554
Office Version
2019
Platform
Windows
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]
 

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
554
Office Version
2019
Platform
Windows
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:

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
53,642
Office Version
365
Platform
Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,101,994
Messages
5,484,073
Members
407,427
Latest member
danbitton

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top