Check textbox for future date

Jimmypop

Well-known Member
Joined
Sep 12, 2013
Messages
753
Office Version
  1. 365
Platform
  1. Windows
Good day again

I would like to when user has entered a date (in any format) inside a textbox that when exiting the textbox it checks whether the date is in the future and then displays a message. Also would it be then able to when exiting that the date be changed to show as format 12-Mar-20?

Please note that there are multiple textboxes where the checks needs to be done and they do not follow each other. They start at TextBox9 then go to 13 then 17 (always increasing by 4). I also cannot put them in a frame seeing as there are other textboxes which contain different info below and next to them.

Any ideas?
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Use these methods to get the values that you require
VBA Code:
    Dim TextBoxDate As Date, FormattedDate As String

    TextBoxDate = CDate(TextBox9.Text)
    FormattedDate = Format(CDate(TextBoxDate), "dd-mmm-yy")
    If TextBoxDate > Date Then MsgBox "future date " & FormattedDate, , "Hey there!"
 
Upvote 0
Use these methods to get the values that you require
VBA Code:
    Dim TextBoxDate As Date, FormattedDate As String

    TextBoxDate = CDate(TextBox9.Text)
    FormattedDate = Format(CDate(TextBoxDate), "dd-mmm-yy")
    If TextBoxDate > Date Then MsgBox "future date " & FormattedDate, , "Hey there!"

Hi Yongle

Does this code go into the TextBox Exit event for every textbox.? Which means I will have to do exit events for 40+ boxes? ? ?
 
Upvote 0
Consider using a class module to accomodate a generic change event for those textboxes
Here is a thread with an example of how that is done

I have no depth of knowledge in this area - so cannot help
Perhaps @Jaafar Tribak (who was active on that thread) will spot that he has been mentioned here and pop along and help
Good luck :)
 
Upvote 0
Consider using a class module to accomodate a generic change event for those textboxes
Here is a thread with an example of how that is done

I have no depth of knowledge in this area - so cannot help
Perhaps @Jaafar Tribak (who was active on that thread) will spot that he has been mentioned here and pop along and help
Good luck :)

Hi Yongle

Thanks. I have tried Class Module before but could not get it right. The problem I am sitting with will be explained:

First I went and updated the textboxes that I do want the code to run on by going into their properties and adding "date" in the Tag section. I then updated code as follows:

Class1 Class Module:

VBA Code:
Option Explicit
Public WithEvents TxtBx As MSForms.TextBox
Private Sub TxtBx_Change()
    TxtBx.value = Format(TxtBx, "dd-mmm-yyyy")
End Sub

Userform Code:

VBA Code:
Private Sub UserForm_Initialize()
        Dim oCtrl As Control, oClass As Class1
    For Each oCtrl In Me.Controls
        If oCtrl.Tag = "date" Then
            Set oClass = New Class1
            Set oClass.TxtBx = oCtrl
            oCol.Add oClass
        End If
    Next oCtrl
End Sub

And I placed this at top of code before all else:

VBA Code:
Option Explicit
Private oCol As New Collection

So, when I tested it works brilliant because as soon as I type something it picks up that the textbox has been changed and it inserts the format for the date automatically, and whenever I want to correct it, obviously it updates the format seeing as it is a change event.

Ideally it would have worked great on an Exit event, but from my previous try with a class module I know that a custom textbox class does not have an Exit event.

I have also thought of just adding a date picker on the textbox enter but not all users at my work has the date picker control available...seems Excel removed it for some reason in recent updates.

So I will wait and see if @Jaafar Tribak maybe has a solution.

Thanks again @Yongle (maybe I did find something VBA cannot do... :ROFLMAO: :ROFLMAO: ?:ROFLMAO::ROFLMAO:)
 
Upvote 0
The following Class will hook the Enter,Exit,BeforeUpdate and AfterUpdate events of textboxes added at runtime :

Workbook Example


1- Class code : ( Class name is CTextBoxEvents)
VBA Code:
Option Explicit

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

#If VBA7 Then
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, lpiid As GUID) As Long
    Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As LongPtr) As Long
#Else
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, lpiid As GUID) As Long
    Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long
#End If


Private oTextBox As Object


Public Property Let SetControlEvents(ByVal TextBox As Object, ByVal SetEvents As Boolean)

    Const S_OK = &H0
    Static lCookie As Long
    Dim tIID As GUID
    
        Set oTextBox = TextBox
        If IIDFromString(StrPtr("{00020400-0000-0000-C000-000000000046}"), tIID) = S_OK Then
            Call ConnectToConnectionPoint(Me, tIID, SetEvents, TextBox, lCookie)
            If lCookie Then
                Debug.Print "Connection set for: " & TextBox.Name
            Else
                Debug.Print "Connection failed for: " & TextBox.Name
            End If
        End If

End Property



Public Sub OnEnter()

    'Attribute OnEnter.VB_UserMemId = &H80018202
    Debug.Print "[ENTER EVENT] " & oTextBox.Name & vbTab & "Value: " & vbTab & oTextBox.Value

End Sub

Public Sub OnExit(ByVal Cancel As MsForms.ReturnBoolean)

    ' Attribute OnExit.VB_UserMemId = &H80018203
    Debug.Print "[EXIT EVENT] " & oTextBox.Name & vbTab & "Value: " & vbTab & oTextBox.Value

End Sub

Public Sub BeforeUpdate(ByVal Cancel As MsForms.ReturnBoolean)

    'Attribute BeforeUpdate.VB_UserMemId = &H80018201
    Debug.Print "[BEFORE_UPDATE EVENT] " & oTextBox.Name & vbTab & "Value: " & vbTab & oTextBox.Value

End Sub

Public Sub AfterUpdate()

    'Attribute AfterUpdate.VB_UserMemId = &H80018200
    Debug.Print "[AFTER_UPDATE EVENT] " & oTextBox.Name & vbTab & "Value: " & vbTab & oTextBox.Value

End Sub



2- Code Usage in the UserForm Module:
VBA Code:
Option Explicit


Private Sub UserForm_Activate()

    Dim oCtrl As Control, i As Integer, lTop As Long
    
    'add 4 textboxes at runtime
    lTop = 20
    For i = 1 To 4
        Set oCtrl = Me.Controls.Add("Forms.TextBox.1", "TextBox" & i, True)
        With oCtrl
            oCtrl.Top = lTop: oCtrl.Left = 75
        End With
        lTop = lTop + 30
    Next i

End Sub


Private Sub UserForm_AddControl(ByVal Control As MsForms.Control)

    Static oCol As Collection
    Dim oTextBoxEvents As CTextBoxEvents
    
    'hook the added textboxes events.
    If TypeOf Control Is MsForms.TextBox Then
        Set oTextBoxEvents = New CTextBoxEvents
        oTextBoxEvents.SetControlEvents(Control) = True
        If oCol Is Nothing Then
            Set oCol = New Collection
        End If
        oCol.Add oTextBoxEvents
    End If

End Sub

See if you can adapt the code for Textboxes that are added at Design time... It should be easy.
 
Upvote 0
The following Class will hook the Enter,Exit,BeforeUpdate and AfterUpdate events of textboxes added at runtime :

Workbook Example


1- Class code : ( Class name is CTextBoxEvents)
VBA Code:
Option Explicit

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

#If VBA7 Then
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, lpiid As GUID) As Long
    Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As LongPtr) As Long
#Else
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, lpiid As GUID) As Long
    Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long
#End If


Private oTextBox As Object


Public Property Let SetControlEvents(ByVal TextBox As Object, ByVal SetEvents As Boolean)

    Const S_OK = &H0
    Static lCookie As Long
    Dim tIID As GUID
  
        Set oTextBox = TextBox
        If IIDFromString(StrPtr("{00020400-0000-0000-C000-000000000046}"), tIID) = S_OK Then
            Call ConnectToConnectionPoint(Me, tIID, SetEvents, TextBox, lCookie)
            If lCookie Then
                Debug.Print "Connection set for: " & TextBox.Name
            Else
                Debug.Print "Connection failed for: " & TextBox.Name
            End If
        End If

End Property



Public Sub OnEnter()

    'Attribute OnEnter.VB_UserMemId = &H80018202
    Debug.Print "[ENTER EVENT] " & oTextBox.Name & vbTab & "Value: " & vbTab & oTextBox.Value

End Sub

Public Sub OnExit(ByVal Cancel As MsForms.ReturnBoolean)

    ' Attribute OnExit.VB_UserMemId = &H80018203
    Debug.Print "[EXIT EVENT] " & oTextBox.Name & vbTab & "Value: " & vbTab & oTextBox.Value

End Sub

Public Sub BeforeUpdate(ByVal Cancel As MsForms.ReturnBoolean)

    'Attribute BeforeUpdate.VB_UserMemId = &H80018201
    Debug.Print "[BEFORE_UPDATE EVENT] " & oTextBox.Name & vbTab & "Value: " & vbTab & oTextBox.Value

End Sub

Public Sub AfterUpdate()

    'Attribute AfterUpdate.VB_UserMemId = &H80018200
    Debug.Print "[AFTER_UPDATE EVENT] " & oTextBox.Name & vbTab & "Value: " & vbTab & oTextBox.Value

End Sub



2- Code Usage in the UserForm Module:
VBA Code:
Option Explicit


Private Sub UserForm_Activate()

    Dim oCtrl As Control, i As Integer, lTop As Long
  
    'add 4 textboxes at runtime
    lTop = 20
    For i = 1 To 4
        Set oCtrl = Me.Controls.Add("Forms.TextBox.1", "TextBox" & i, True)
        With oCtrl
            oCtrl.Top = lTop: oCtrl.Left = 75
        End With
        lTop = lTop + 30
    Next i

End Sub


Private Sub UserForm_AddControl(ByVal Control As MsForms.Control)

    Static oCol As Collection
    Dim oTextBoxEvents As CTextBoxEvents
  
    'hook the added textboxes events.
    If TypeOf Control Is MsForms.TextBox Then
        Set oTextBoxEvents = New CTextBoxEvents
        oTextBoxEvents.SetControlEvents(Control) = True
        If oCol Is Nothing Then
            Set oCol = New Collection
        End If
        oCol.Add oTextBoxEvents
    End If

End Sub

See if you can adapt the code for Textboxes that are added at Design time... It should be easy.

Hi Jafaar

I replaced my class module with 1- Class code : ( Class name is CTextBoxEvents) but now getting User -defined type not defined on line:

VBA Code:
Private Sub UserForm_Initialize()

    Dim oCtrl As Control, oClass As Class1 '[B]getting the error on this line and it highlights the oClass As Class1 section[/B]
   
    For Each oCtrl In Me.Controls
        If oCtrl.Tag = "date" Then
            Set oClass = New Class1
            Set oClass.TxtBx = oCtrl
            oCol.Add oClass
        End If
    Next oCtrl
End Sub
 
Upvote 0
UPDATE:

Should also mention that I am a beginner and my code in reply #5 I only got working I think by pure luck. As stated there it works exactly as I want it is just on a change event and not a enter or exit event, and at momnet I am just seeing code inj front of me and have no clue how to update the code for textboxes at design timeo_O??
 
Upvote 0
Sans titre.png



Hi Jimmypop

So you are wanting to have a generic Exit event for various textboxes whose Tag Property is "date" right ? If so, then you can use this code in the userform module :
VBA Code:
Option Explicit

Private Sub UserForm_Initialize()

    Dim oCtrl As Control, oClass As CTextBoxEvents
 
    For Each oCtrl In Me.Controls
        If oCtrl.Tag = "date" Then
            Set oClass = New CTextBoxEvents
            oClass.SetControlEvents(oCtrl) = True
        End If
    Next oCtrl
End Sub

The Class code stays the same.


The above picture shows how the 3 textboxes accross the top have been hooked and how they handle the Exit, Enter , BeforeUpdate and AfterUpdate events. (Look at the immediate window output at the bottom)

The smaller textbox located at the bottom is not hooked because its Tag Property is not "date"... If you change its Tag Property to "date" it will too be hooked just like the other 3 TextBoxes.

And here is a Workbook Example
 
Upvote 0
View attachment 8930


Hi Jimmypop

So you are wanting to have a generic Exit event for various textboxes whose Tag Property is "date" right ? If so, then you can use this code in the userform module :
VBA Code:
Option Explicit

Private Sub UserForm_Initialize()

    Dim oCtrl As Control, oClass As CTextBoxEvents

    For Each oCtrl In Me.Controls
        If oCtrl.Tag = "date" Then
            Set oClass = New CTextBoxEvents
            oClass.SetControlEvents(oCtrl) = True
        End If
    Next oCtrl
End Sub

The Class code stays the same.


The above picture shows how the 3 textboxes accross the top have been hooked and how they handle the Exit, Enter , BeforeUpdate and AfterUpdate events. (Look at the immediate window output at the bottom)

The smaller textbox located at the bottom is not hooked because its Tag Property is not "date"... If you change its Tag Property to "date" it will too be hooked just like the other 3 TextBoxes.

And here is a Workbook Example

Hi Jafaar

Everything working as it should. Thank you very much. Apologies for only getting back now but I do not work on weekends.

After having been away from PC for a weekend I saw where I had made most of my errors. My class module was named Class1 and the code was looking for class named CTextBoxEvents. Thinking that is where my errors kept originating. Today I removed all class modules and coding and exported yours from workbook example and then imported to mine. Thanks again for all assistance. Now I am go to try and incorporate a very nice looking custom made date picker into my code. Will shout on new thread if any assistance is required. ? ?
 
Upvote 0

Forum statistics

Threads
1,223,882
Messages
6,175,166
Members
452,615
Latest member
bogeys2birdies

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