How to compare two values in VBA when a value is bound to vbNewLine in Excel or Access

Question

This is about the structure of a calendar and since I already have too many functions built in, I am not allowed to change the block with vbNewLine , so I need to find a way to solve the problem at this one point:

A function should compare two values and trigger an action in case of a match.

The value myArray(i, 2) ist the Day-Number:

Private Sub InitVariables()

intMonth = Me.cboMonth
intYear = Me.cboYear
lngFirstDayOfMonth = CLng(DateSerial(intYear, intMonth, 1))
intFirstWeekday = getFirstWeekday(lngFirstDayOfMonth)
intDaysInMonth = getDaysInMonth(intMonth, intYear)

End Sub

Private Sub InitArray()
Dim i As Integer

ReDim myArray(0 To 41, 0 To 2)

For i = 0 To 41

    myArray(i, 0) = lngFirstDayOfMonth - intFirstWeekday + 1 + i
    If Month(myArray(i, 0)) = intMonth Then
        myArray(i, 1) = True
        myArray(i, 2) = Day(myArray(i, 0))
    Else
        myArray(i, 1) = False
    
    End If
Next i

End Sub

Private Sub LoadArray()

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsFiltered As DAO.Recordset
Dim strsql As String
Dim i As Integer
Dim OrgTime As Date
Dim MyStrTime As String

On Error Resume Next

strsql = "SELECT * from qrytblImVst;"

Set db = CurrentDb
Set rs = db.OpenRecordset(strsql)

    If Not rs.BOF And Not rs.EOF Then

        For i = LBound(myArray) To UBound(myArray)

            If myArray(i, 1) Then
                rs.Filter = "[vDate]=" & myArray(i, 0)

                Set rsFiltered = rs.OpenRecordset

                Do While (Not rsFiltered.EOF)
                
                    OrgTime = rsFiltered!vZeit
                    MyStrTime = Format(OrgTime, "hh:mm")
                    
                    myArray(i, 2) = myArray(i, 2) & vbNewLine _
                    & "<div><font color=red> " + MyStrTime + "  </div>"

                    End If
                    
                    rsFiltered.MoveNext
                Loop

            End If
        Next i

    End If

    rsFiltered.Close
    rs.Close

Set rsFiltered = Nothing
Set rs = Nothing
Set db = Nothing

End Sub

Private Sub PrintArray()

'On Error Resume Next

Dim strCtlName As Variant
Dim strCtlName1 As Variant
Dim i As Integer
Dim lngBlack As Long
Dim lngWhite As Long

lngBlack = RGB(36, 39, 50)
lngWhite = RGB(166, 166, 166)

For i = LBound(myArray) To UBound(myArray)
    
    strCtlName = "TXT" & CStr(i + 1)
    Controls(strCtlName).Tag = i
    Controls(strCtlName) = ""
    Controls(strCtlName) = myArray(i, 2)

If IsNull(Controls(strCtlName)) Then
Controls(strCtlName).Visible = False
Else
Controls(strCtlName).Visible = True
End If

If CStr(Me.cboMonth) = CStr(Month(Date)) And CStr(Me.cboYear) = CStr(Year(Date)) And Len(myArray(i, 2)) <> 0 Then
    If Split(myArray(i, 2), vbNewLine)(0) = CStr(Day(Date)) Then
         Controls(strCtlName).BorderColor = lngRed
         Controls(strCtlName).BorderWidth = 2
    End If
Else
Controls(strCtlName).BorderColor = lngWhite
Controls(strCtlName).BorderWidth = 1
End If

    strCtlName = "CAL" & CStr(i + 1)
    Controls(strCtlName).Tag = i
    Controls(strCtlName) = ""
    If InStr(myArray(i, 2), "div") Then
    Controls(strCtlName) = Left(myArray(i, 2), 2)
    Else
    Controls(strCtlName) = myArray(i, 2)
    End If

If IsNull(Controls(strCtlName)) Then
Controls(strCtlName).Visible = False
Else
Controls(strCtlName).Visible = True
End If

Next i

End Sub

This is how the comparison looks:

If Left(myArray(i, 2), 2) = CStr(Day(Date)) Then
     Controls(strCtlName).BorderColor = lngRed
     Controls(strCtlName).BorderWidth = 2
End If

I always get a FALSE as a result because vbNewLine changes the day number value in such a way that there is no match.

To check what is causing the problem I added "//" and it looks like this

msgbox Left(myArray(i, 2), 2) & "//"

The result is:

5
 //

How can I solve this problem, for all calendar days? Thanks!

Answer 1

Your comparison is looking at the first two characters of the stored value. When the day number is less than 10, the second character will be vbNewLine because the day number is only one digit.

Instead of using Left to capture a fixed number of characters, you can use Split to capture everything to the left of vbNewLine.

If Split(myArray(i, 2), vbNewLine)(0) = CStr(Day(Date)) Then
     Controls(strCtlName).BorderColor = lngRed
     Controls(strCtlName).BorderWidth = 2
End If

---

Split will return Error (9) when myArray(i,2) doesn't have a value. You'll need to introduce a check for that case:

If Len(myArray(i,2)) <> 0 Then
    If Split(myArray(i, 2), vbNewLine)(0) = CStr(Day(Date)) Then
         Controls(strCtlName).BorderColor = lngRed
         Controls(strCtlName).BorderWidth = 2
    End If
End If