Сравнение столбцов таблицы с текущей датой в excel VBA

Question

Я пытаюсь написать excel VBA для сравнения столбцов таблицы с текущей датой и выделить, если true.

Ниже приведен пример таблицы:

Код, который я работаю на это:

Private Sub Workbook_Open() 
    Dim tbl As Excel.ListObject 'Table name 
    Dim lr As Excel.ListRow 'Row index 
    Dim ws As Excel.Worksheet 'Work sheet 
    'column names 
    Dim keepInTouch As Range, invite As Range, present As Range, follow As Range 

    Set ws = ThisWorkbook.Worksheets(1)         'select work book index 1 
    Set tbl = ws.ListObjects("ContactList")        'set ContactList to tbl 
    Set keepInTouch = tbl.ListColumns("Keep in Touch").DataBodyRange 'Select the appropreate header 
    Set invite = tbl.ListColumns("Invite").DataBodyRange 
    Set present = tbl.ListColumns("Present").DataBodyRange 
    Set follow = tbl.ListColumns("Follow").DataBodyRange 
    'MsgBox tbl 
    For Each lr In tbl.ListRows 
     If lr.Range(1, tbl.ListColumns("Keep in Touch").Index).Value <> Date Then 
      keepInTouch.Interior.ColorIndex = xlNone 
      keepInTouch.Font.ColorIndex = 1 
      keepInTouch.Font.Bold = False 
     'If keepInTouch(1).Value = Date And keepInTouch(1).Value <> "" Then 
     ElseIf lr.Range(1, tbl.ListColumns("Keep in Touch").Index).Value = Date Then 
      keepInTouch.Interior.ColorIndex = 3 
      keepInTouch.Font.ColorIndex = 2 
      keepInTouch.Font.Bold = True 
     End If 
     Next lr 
End Sub 

Line 19: If keepInTouch.Index = Date And keepInTouch.Index <> "" Then вызывает

Run time error '438': 
Object doesn't support this property or method. 

Что такое правильный способ сделать это?

Answer 1

If lr.Range(1, tbl.ListColumns("Keep in Touch").Index).Value = Date Then 

Например lr.Range(1, 2) это вторая ячейка в столбце ListRow Range

keepInTouchIndex = tbl.ListColumns("Keep in Touch").Index 
NameIndex = tbl.ListColumns("Name").Index 

For Each lr In tbl.ListRows 
    With lr.Range.Cells(1, NameIndex) 
     If lr.Range.Cells(1, keepInTouchIndex).Value <> Date Then 
      .Interior.ColorIndex = 3 
      .Font.ColorIndex = 2 
      .Font.Bold = True 
     Else 
      .Interior.ColorIndex = xlNone 
      .Font.ColorIndex = 1 
      .Font.Bold = False 
     End If 
    End With 
Next lr