Search code examples
excelvbauserform

Code for changing color of text box only working for when the day is less or more than today, not for the whole date


I want the text box in for UserForm to be green when date is in the future and red when date is in the past.

For some reason the script is only changing the colors correctly when the day of the month is less or more than the current day. For example:

Todays date is 19/08/23 (dd/mm/yy format as I am UK based)

If text box is 18/8/23 it turns red as 18<19. If text box is 20/8/23 it turns green because 20>19. However, it does not seem to take into account the months or years. For example:

If text box is 18/8/25 it turns red because 18<19. However, that date is in 2025 so should turn green. Also if text box is 20/8/21 it turns green because 20>19. However, that date is in 2021 so should turn red.

Here it the code I am running for it:

Private Sub TextBox_Change()

If TextBox.Text < Date Then
    TextBox.BackColor = RGB(255, 0, 0)
ElseIf TextBox.Text >= Date Then
    TextBox.BackColor = RGB(0, 255, 0)
    
End If

End Sub

Additionally if one would help to add additional code so it could also turn amber when the date is within 1 week of today. I cannot seem to find a way for it to work for me. So I have kept it as above for now.

I have tried changing the cell in which the dates are in to "short date" and also as "general" and as "text". Problem persists. I also checked to make sure it was set to UK dates so it was dd/mm/yy.

I am fairly new to VBA. Have tried to find relevant forum posts similar to no avail but please link me if I have missed them.

I have managed to successfully do things like this before with conditional formatting in excel but never as a UserForm using VBA. enter image description here


Solution

  • Private Sub TextBox_Change()
        Dim d
        With Me.TextBox
            If Len(.Text) >= 6 And IsDate(.Text) Then
                d = DateDiff("d", Date, CDate(.Text))
                If d < 0 Then
                    .BackColor = RGB(255, 0, 0)
                ElseIf d < 7 Then
                    .BackColor = RGB(255, 192, 0)
                Else
                    .BackColor = RGB(0, 255, 0)
                End If
            Else
                .BackColor = RGB(255, 255, 255)
            End If
       End With
    End Sub