Hyperlink column data for two columns only working for one

[eli_m]

Hi,
Column A hyperlinks from Column Q but Column AH isn't hyperlinking with data from AH - does anyone know why this won't work?:

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

    If Target.Count <> 1 Then Exit Sub
    If Not Intersect(Target, Range("Q3:Q200")) 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
    
    
        sURI = "https://mydhl.express.dhl/au/en/tracking.html#/results?id="

    'Conditions for event driven
    If Target.Count <> 1 Then Exit Sub
    If Not Intersect(Target, Range("AH3:AH200")) Is Nothing Then

        On Error GoTo ErrLine
        Application.EnableEvents = False

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

        'Add a Hyperlink
        If Target.Value <> "" Then    ' If Reference column is NOT blank
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(Target.Row, "AH"), Address:= _
                                       sURI & Target.Value, TextToDisplay:=Cells(Target.Row, "AH").Value
        Else
            Cells(Target.Row, "AH").Hyperlinks.Delete    'Delete Hyperlink when AH is empty
        End If
        'Set hyperlink text
        With Cells(Target.Row, "AH").Font
            .Parent.Style = "Normal"    'Added
            .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:AS"))
    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

    ' Ignore Errors with Worksheet Clicks
    Dim r As Range: Set r = Range("A2:AS200")
    Dim cel As Range

    For Each cel In r
        With cel
            .Errors(8).Ignore = True    'Data Validation Error
            .Errors(9).Ignore = True    'Inconsistent Error
            .Errors(6).Ignore = True    'Lock Error
        End With
    Next cel

ErrLine:        'Just in case, enable event
    Application.EnableEvents = True

End Sub

Thanks in advance