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

[willow1985]

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

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

 

[Joe4]

A few things.

1. Why are you trying to pass a parameter of 2 when the procedure does not accept any arguments?

Call ValidateDate([COLOR=#ff0000][B]2[/B][/COLOR])

Private Sub ValidateDate()

2. If you want to limit this to changes to cell B2 only, then you should use:

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]

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:

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

 

[willow1985]

I get a number format is out of range error for: c.NumberFormat = "[$-409]d-mmm-yy;@"

 

[Joe4]

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):

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]

I find the code doesn't work now. I enter in a letter in cell B2 and nothing happens.

 

[Joe4]

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:

Application.EnableEvents = False

and this line didn't:

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:

Private Sub FixIt()
    Application.EnableEvents = True
Exit Sub

Do that, and the code should work again.

 

[willow1985]

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.

[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]

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

 

[Joe4]

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.