VBA 시간이 지나면 자동으로 특정 셀에 텍스트가 추가되게 하는 코드를 짤 수 있나요?

Sub DoExpire()
    Dim sh As Worksheet, Cell As Range
    Set sh = Worksheets("Sheet1")
 
    For Each Cell In sh.Range("B2:B" & sh.Cells(sh.Rows.Count, "B").End(xlUp).Row)
        If Cell.Value2 < Application.EDate(Date, -6) Then
            If InStr(1, Cell.Offset(, 2).Value2, "Expired", vbTextCompare) = 0 Then Cell.Offset(, 2) = Cell.Offset(, 2) & "/Expired"
        End If
    Next Cell
End Sub

Private Sub Workbook_Open()
    Call DoExpire
End Sub