Copy Cell as Hyperlink to another cell

[eli_m]

Hi All,

I have the below code that if a Cell in Column S is populated it will hyperlink the Cell In Column A with https://cases.com/cases/ then Column S cell data.
example:
- Cell in Column S = 1234
- Cell in Column A hyperlink is https://cases.com/cases/1234

This has been working great for me but now I want to make it so that if Column AG is populated with a DATE it changes the above to hyperlink to https://bookings.com/bookings/ then Column BS data.
example:
- Cell in Column AG is now populated with 12/12/24 (date)
- Column BS =9876
- Cell in Column A hyperlink is changed to https://bookings.com/bookings/9876

How would I go by changing the below code?

Private Sub Worksheet_Change(ByVal Target As Range)
    Const sURI As String = "https://cases.com/cases/"

    If Target.Count <> 1 Then Exit Sub
    If Not Intersect(Target, Range("S3:S200")) Is Nothing Then

        On Error GoTo ErrLine
        Application.EnableEvents = False

        With ActiveWorkbook.Styles("Followed Hyperlink").Font
            .Color = RGB(0, 0, 0)
        End With

        If Target.Value <> "" Then
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(Target.Row, "A"), Address:= _
                                       sURI & Target.Value, TextToDisplay:=Cells(Target.Row, "A").Value
        Else
            Cells(Target.Row, "A").Hyperlinks.Delete
        End If
 
        With Cells(Target.Row, "A").Font
            .Parent.Style = "Normal"
            .Name = "Calibri"
            .Size = 12
            .Bold = True
            .Color = vbBlack
            .Underline = xlUnderlineStyleNone
        End With
    End If

    If Target.CountLarge / Rows.Count = Int(Target.CountLarge / Rows.Count) Then Exit Sub    'Exit code if whole columns are edited

    ' Copy from Line 200 into deleted cells
    Dim Changed As Range, c As Range

    Set Changed = Intersect(Target, Columns("A:AQ"))
    If Not Changed Is Nothing Then
        Application.EnableEvents = False
        For Each c In Changed
            If Len(c.Text) = 0 Then Cells(200, c.Column).Copy Destination:=c
        Next c
        Application.EnableEvents = True
    End If

  
End Sub

Thanks in advance

 

[eli_m]

anyone ?