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]

Interesting, when I load a textbox with a date from a cell I get the date in d/m/yyyy format.
What happens if you make this change

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

 

[Nathan_Barratt]

This will deal with the initial loopCode:
For i = 1 To 51 Step 2
Me.Controls("tbcomp" & i).Value = y.Offset(, i).Value
Me.Controls("tbDue" & i).Value = y.Offset(, i + 1).Value
Next i

Just tried this bit and that populates every other set of text boxes and on this occasion I can see why.

My tbComp & tbDue text boxes are numbered 1 to 51

my offsets for the tbComp.value are 1, 3, 5, 7 etc up to 101

My offsets for the tbDue value are 2, 4, 6, 8 etc up to 102

So I need to incorporate both. or as in your first suggestion have my for i = 1 to 102 but cease that iteration at 51 for tbComp & tbDue. Is This possible ???

 

[Fluff]

How about

   j = 1
   For i = 1 To 51 Step 1
      Me.Controls("tbcomp" & i).Value = y.Offset(, j).Value
      Me.Controls("tbDue" & i).Value = y.Offset(, j + 1).Value
      j = j + 2
   Next i

 

[Nathan_Barratt]

Interesting, when I load a textbox with a date from a cell I get the date in d/m/yyyy format.
What happens if you make this changeCode:
For i = 1 To 51 Step 2
Me.Controls("tbcomp" & i).Value = y.Offset(, i).Value
Me.Controls("tbDue" & i).Value = y.Offset(, i + 1).Text
Next i

This brings the same type mismatch code.

I shall revisit in the morning as its getting late here - Thanks again for your assistance i have certainly learnt to look at things from another angle. Hopefully one of us (more than likely YOU) will come up with a solution. I think i have made a fundamental mistake somewhere when building userforms etc.

Just as a point, and it has just come to me and was one of the reasons i thought you were probably correct with the dates as text thing - my users input the dates via another userform which uses a textbox for the purpose. I told them to input as e.g 8Aug18 (with no spaces) as excel would do the rest when the sheet receives the data - and it appears it has done as they are formatting as dates on the sheet. Does this help your thinking??

 

[Nathan_Barratt]

How about

   j = 1
   For i = 1 To 51 Step 1
      Me.Controls("tbcomp" & i).Value = y.Offset(, j).Value
      Me.Controls("tbDue" & i).Value = y.Offset(, j + 1).Value
      j = j + 2
   Next i

This Sir - Has Nailed it as they say - Thank you. I will now try to understand what is happening so that i apply it in the future.

 

[Fluff]

Glad to help & thanks for the feedback

 

[Nathan_Barratt]

Just need to sort that colour thing out now. I’m sure it’s something simple I just need to figure it out.

 

[Fluff]

Would you be able to share a desensitised copy of your workbook, as I cannot figure out what is going wrong?

 

[Nathan_Barratt]

Can this be done so that only you can view the workbook?

I realized something last night after the euphoria of getting help subsided. The tbDue Value comes from a calculated field (a date + an edate figure in a worksheet formula) does this influence things. This formula also accounts for blank cells by returning "NO DATA" in the cell with the tbDue value in. MAYBE I SHOULD HAVE THOUGHT OF THIS EARLIER - APOLOGIES

 

[Nathan_Barratt]

Well......... It would appear that I have done it.

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)
        
 j = 1
   For i = 1 To 51 Step 1
      Me.Controls("tbcomp" & i).Value = y.Offset(, j).Value
      Me.Controls("tbDue" & i).Value = y.Offset(, j + 1).Value
      If y.Offset(, j + 1).Value < Date Then
      Me.Controls("tbDue" & i).ForeColor = vbRed
      End If
      j = j + 2
      
   Next i
        
   
End Sub

I based the color change code on the sheet cell where the date is and stuck it in the search code and hey presto.

Thanks for all your help, I wouldn't have got there otherwise. Got me thinking from different angles.

You're a star.