Add Conditional Formatting to a Hyperlink

[XrayLemi]

I have a workbook with an Index. The index is Dynamic. If I add a new sheet, the index grows. If I change a sheet's visibility to xlSheetVeryHidden, It is removed from the index. Each entry in the list is also a hyperlink to each sheet in the workbook. It is done with Worksheet Activate so It will update any time I go Back to the index. This works fine.

I have tried, and failed miserably to add conditional formatting to the hyperlinked cells in the index. I would like the cells to turn yellow if the date in cell D1 on each sheet in the index is 1 year old. Turn red if it is over 2 years old. I cannot even find an example of this on the internet.

I have also tried to add a second column to the index with Just the date from cell D1 to correspond with the hyperlink in column 2. This way I can add the Conditional formatting to that column. Total failure with this as well.

I hope someone can help me figure this out.
Thank you very much in advance,
Jim

Here is the code on the Index Sheet.

Private Sub Worksheet_Activate()

Dim sht As Worksheet
Dim TOCsht As Worksheet
Dim RowNo As Integer

Set TOCsht = Sheet29
TOCsht.Unprotect Password:="Password"
TOCsht.Cells.Clear

With TOCsht.Cells(1, 2)
    .Value = "Index"
    .Font.Bold = True
    .Font.Size = 20
    .HorizontalAlignment = xlCenter
End With

RowNo = 1

For Each sht In ThisWorkbook.Worksheets
    If sht.CodeName <> "Sheet29" And sht.Visible <> xlSheetVeryHidden Then
        RowNo = RowNo + 1
        TOCsht.Cells(RowNo, 2).Hyperlinks.Add _
        Anchor:=Cells(RowNo, 2), _
        Address:="", SubAddress:="'" & sht.Name & "'!F6", _
        ScreenTip:="", _
        TextToDisplay:=sht.Name
    End If
Next sht

Dim r As Range, c As Range
Set r = Range(Range("B2"), Range("B2").End(xlDown))
For Each c In r
With c.Font
        .Size = 12
End With
Next

End Sub

 

[HaHoBe]

Hi Jim,

to my knowledge a hyperlink should indicate whether a link has been used or not so that may be the reason you haven't found any code for what you want to do with that feature.

Private Sub Worksheet_Activate()
' https://www.mrexcel.com/board/threads/add-conditional-formatting-to-a-hyperlink.1232260/
Dim ws          As Worksheet
Dim wsTOC       As Worksheet
Dim lngRow      As Long

Set wsTOC = Sheet29

wsTOC.Unprotect Password:="Password"
wsTOC.Cells.Clear

With wsTOC.Cells(1, 2).Resize(1, 2)
  .Value = Array("Index", "Date")
  .Font.Bold = True
  .Font.Size = 20
  .EntireColumn.HorizontalAlignment = xlCenter
End With

lngRow = 1

For Each ws In ThisWorkbook.Worksheets
  If ws.CodeName <> "Sheet29" And ws.Visible <> xlSheetVeryHidden Then
    lngRow = lngRow + 1
    wsTOC.Cells(lngRow, 2).Hyperlinks.Add _
        Anchor:=wsTOC.Cells(lngRow, 2), _
        Address:="", SubAddress:="'" & ws.Name & "'!F6", _
        ScreenTip:="", _
        TextToDisplay:=ws.Name
    wsTOC.Cells(lngRow, 3).Value = ws.Range("D1")
  End If
Next ws

With wsTOC
  With .Range("B2", .Range("B2").End(xlDown))
    .Font.Size = 12
    .Offset(0, 1).NumberFormat = "m/d/yyyy"
  End With
End With

wsTOC.Protect Password:="Password"

Set wsTOC = Nothing

End Sub

Ciao,
Holger

 

[XrayLemi]

Hello Holger,
For my needs, the color of the text for the Hyper link doesn't matter. What I need is a way to see if the date on the sheet that is linked to the hyper link is over due.
Best,
Jim

 

[HaHoBe]

Hi Jim,

change the colour of the font which is normally blue for an unused hyperlink (I find yellow on white hard to read, maybe change the background colour of these cells):

Private Sub Worksheet_Activate()
' https://www.mrexcel.com/board/threads/add-conditional-formatting-to-a-hyperlink.1232260/
' updated 2023-03-15, change colour of hyperlinks
Dim ws            As Worksheet
Dim wsTOC         As Worksheet
Dim lngRow        As Long
Dim lngCol     As Long

Set wsTOC = Sheet29

wsTOC.Unprotect Password:="Password"
wsTOC.Cells.Clear

With wsTOC.Cells(1, 2)
  .Value = "Index"
  .Font.Bold = True
  .Font.Size = 20
  .EntireColumn.HorizontalAlignment = xlCenter
End With

lngRow = 1

For Each ws In ThisWorkbook.Worksheets
  If ws.CodeName <> "Sheet29" And ws.Visible <> xlSheetVeryHidden Then
    lngRow = lngRow + 1
    With wsTOC.Cells(lngRow, 2)
      .Hyperlinks.Add _
          Anchor:=wsTOC.Cells(lngRow, 2), _
          Address:="", SubAddress:="'" & ws.Name & "'!F6", _
          ScreenTip:="", _
          TextToDisplay:=ws.Name
      If ws.Range("D1").Value <= DateSerial(Year(Date) - 2, Month(Date), Day(Date)) Then
        lngCol = 255
      ElseIf ws.Range("D1").Value <= DateSerial(Year(Date) - 1, Month(Date), Day(Date)) Then
        lngCol = 65535
      Else
        lngCol = 16711680
      End If
      .Font.Color = lngCol
    End With
  End If
Next ws

wsTOC.Protect Password:="Password"

Set wsTOC = Nothing

End Sub

Ciao,
Holger

 

[XrayLemi]

Hello Holger!
It took a few to figure things out. This is Perfect!
Thank you so much!
Jim