TextBox Forecolor Based on Dates

[Nathan_Barratt]

Good afternoon all.

I wonder if someone might give me some direction on the following.

The code is in a userform named ufTrainingRecord

The top half of the code works fine although a little long winded I admit. I have commented within the code "FROM HERE DOWN" where I am having issues.

It is nearly doing what I want however it is only basing its outcome (changing forecolor to vbRed) on the first two digits of the date in the textboxes and not the full date.

I know this will be something rather mundane that i just haven't thought of and i suspect it is to do with date formatting but i just can't find an answer.

Thanks for your time.

Private Sub cbTrainingName_Change()



Dim y As Range
Dim i As Integer
   
Set y = Sheets("Training Matrix").Columns(1).Find(what:=cbTrainingName.Value, After:=Sheets("Training Matrix").Cells(1, 1), _
        LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=True)
 
tbComp1.Value = y.Offset(, 1).Value
tbComp2.Value = y.Offset(, 3).Value
tbComp3.Value = y.Offset(, 5).Value
tbComp4.Value = y.Offset(, 7).Value
tbComp5.Value = y.Offset(, 9).Value
tbComp6.Value = y.Offset(, 11).Value
tbComp7.Value = y.Offset(, 13).Value
tbComp8.Value = y.Offset(, 15).Value
tbComp9.Value = y.Offset(, 17).Value
tbComp10.Value = y.Offset(, 19).Value
tbComp11.Value = y.Offset(, 21).Value
tbComp12.Value = y.Offset(, 23).Value
tbComp13.Value = y.Offset(, 25).Value
tbComp14.Value = y.Offset(, 27).Value
tbComp15.Value = y.Offset(, 29).Value
tbComp16.Value = y.Offset(, 31).Value
tbComp17.Value = y.Offset(, 33).Value
tbComp18.Value = y.Offset(, 35).Value
tbComp19.Value = y.Offset(, 37).Value
tbComp20.Value = y.Offset(, 39).Value
tbComp21.Value = y.Offset(, 41).Value
tbComp22.Value = y.Offset(, 43).Value
tbComp23.Value = y.Offset(, 45).Value
tbComp24.Value = y.Offset(, 47).Value
tbComp25.Value = y.Offset(, 49).Value
tbComp26.Value = y.Offset(, 51).Value
tbComp27.Value = y.Offset(, 53).Value
tbComp28.Value = y.Offset(, 55).Value
tbComp29.Value = y.Offset(, 57).Value
tbComp30.Value = y.Offset(, 59).Value
tbComp31.Value = y.Offset(, 61).Value
tbComp32.Value = y.Offset(, 63).Value
tbComp33.Value = y.Offset(, 65).Value
tbComp34.Value = y.Offset(, 67).Value
tbComp35.Value = y.Offset(, 69).Value
tbComp36.Value = y.Offset(, 71).Value
tbComp37.Value = y.Offset(, 73).Value
tbComp38.Value = y.Offset(, 75).Value
tbComp39.Value = y.Offset(, 77).Value
tbComp40.Value = y.Offset(, 79).Value
tbComp41.Value = y.Offset(, 81).Value
tbComp42.Value = y.Offset(, 83).Value
tbComp43.Value = y.Offset(, 85).Value
tbComp44.Value = y.Offset(, 87).Value
tbComp45.Value = y.Offset(, 89).Value
tbComp46.Value = y.Offset(, 91).Value
tbComp47.Value = y.Offset(, 93).Value
tbComp48.Value = y.Offset(, 95).Value
tbComp49.Value = y.Offset(, 97).Value
tbComp50.Value = y.Offset(, 99).Value
tbComp51.Value = y.Offset(, 101).Value

tbDue1.Value = y.Offset(, 2).Value
tbDue2.Value = y.Offset(, 4).Value
tbDue3.Value = y.Offset(, 6).Value
tbDue4.Value = y.Offset(, 8).Value
tbDue5.Value = y.Offset(, 10).Value
tbDue6.Value = y.Offset(, 12).Value
tbDue7.Value = y.Offset(, 14).Value
tbDue8.Value = y.Offset(, 16).Value
tbDue9.Value = y.Offset(, 18).Value
tbDue10.Value = y.Offset(, 20).Value
tbDue11.Value = y.Offset(, 22).Value
tbDue12.Value = y.Offset(, 24).Value
tbDue13.Value = y.Offset(, 26).Value
tbDue14.Value = y.Offset(, 28).Value
tbDue15.Value = y.Offset(, 30).Value
tbDue16.Value = y.Offset(, 32).Value
tbDue17.Value = y.Offset(, 34).Value
tbDue18.Value = y.Offset(, 36).Value
tbDue19.Value = y.Offset(, 38).Value
tbDue20.Value = y.Offset(, 40).Value
tbDue21.Value = y.Offset(, 42).Value
tbDue22.Value = y.Offset(, 44).Value
tbDue23.Value = y.Offset(, 46).Value
tbDue24.Value = y.Offset(, 48).Value
tbDue25.Value = y.Offset(, 50).Value
tbDue26.Value = y.Offset(, 52).Value
tbDue27.Value = y.Offset(, 54).Value
tbDue28.Value = y.Offset(, 56).Value
tbDue29.Value = y.Offset(, 58).Value
tbDue30.Value = y.Offset(, 60).Value
tbDue31.Value = y.Offset(, 62).Value
tbDue32.Value = y.Offset(, 64).Value
tbDue33.Value = y.Offset(, 66).Value
tbDue34.Value = y.Offset(, 68).Value
tbDue35.Value = y.Offset(, 70).Value
tbDue36.Value = y.Offset(, 72).Value
tbDue37.Value = y.Offset(, 74).Value
tbDue38.Value = y.Offset(, 76).Value
tbDue39.Value = y.Offset(, 78).Value
tbDue40.Value = y.Offset(, 80).Value
tbDue41.Value = y.Offset(, 82).Value
tbDue42.Value = y.Offset(, 84).Value
tbDue43.Value = y.Offset(, 86).Value
tbDue44.Value = y.Offset(, 88).Value
tbDue45.Value = y.Offset(, 90).Value
tbDue46.Value = y.Offset(, 92).Value
tbDue47.Value = y.Offset(, 94).Value
tbDue48.Value = y.Offset(, 96).Value
tbDue49.Value = y.Offset(, 98).Value
tbDue50.Value = y.Offset(, 100).Value
tbDue51.Value = y.Offset(, 102).Value
 
tbToday = Format(Date, "dd-mmm-yyyy")

'FROM HERE DOWN

For i = 1 To 51
    If Me.controls("tbDue" & i).Value < tbToday.Value Then
     
      
      
            Me.controls("tbdue" & i).ForeColor = vbRed
    End If
    Next I


cbCloseTrainingRecord.SetFocus
    
End Sub

 

[Fluff]

Try

If DateValue(Me.Controls("tbDue" & i).Value) < Date Then

 

[Fluff]

You can alsoe slim down the 1st part of your code like

Private Sub cbTrainingName_Change()
   Dim y As Range
   Dim i As Integer
      
   Set y = Sheets("Training Matrix").Columns(1).find(what:=cbTrainingName.Value, After:=Sheets("Training Matrix").Cells(1, 1), _
           lookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=True)
           
   For i = 1 To 102 Step 2
      Me.Controls("tbcomp" & i).Value = y.Offset(, i).Value
      Me.Controls("tbDue" & i).Value = y.Offset(, i + 1).Value
   Next i
   
   For i = 1 To 51
      If DateValue(Me.Controls("tbDue" & i).Value) < Date Then
         Me.Controls("tbdue" & i).ForeColor = vbRed
      End If
   Next i
   
   cbCloseTrainingRecord.SetFocus
End Sub

 

[Nathan_Barratt]

Firstly Thank you for getting back to me so quickly it really is appreciated.

I replaced my line of code with yours however I am still getting a type mismatch error. (I had the same a couple of times during my efforts)

Secondly thanks for the tips on the slimming down, I tried loops within loops but just couldn't get the hang of it and now looking at your example I see where I was going wrong. Thank you i love learning.

Just one thing, is there a way to stop the iterations of i at 51 in the tbComp & tbDue (there are only 51 of each) but allow it to continue for the y.offset part ?? it errors when it can't find anything above 51.

I suppose i could rename the tb's to match the code if not.

Thanks again, you're a superstar.

 

[Fluff]

This will deal with the initial loop

   For i = 1 To [COLOR=#ff0000]51 [/COLOR]Step 2
      Me.Controls("tbcomp" & i).Value = y.Offset(, i).Value
      Me.Controls("tbDue" & i).Value = y.Offset(, i + 1).Value
   Next i

How are you populating the tbDue textboxes?

 

[Nathan_Barratt]

They are populated from the y.offset value which is a date. The date is in the cell of a Table named “TrainingMatrix” and is formatted dd-mmm-yy it was my initial thought that this might have something to do with the type mismatch but I can’t think myself through it.

Thanks again for the help. I shall look into your latest reply ASAP.

 

[Fluff]

How do the dates appear in the textboxes?

 

[Nathan_Barratt]

They appear the same dd-mmm-yy.

 

[Fluff]

In that case it sounds like your dates may not be dates but text.
If you format the dates in your sheets as General, what do you see?

 

[Nathan_Barratt]

When I format them as general I see the numerical value for the date