I would have thought you would just replace your y/x loops with a basic range iteration, along lines of below (only modified existing code where relevant):

Public Sub HighlightFirstOccurrence()
    Dim d As Object
    Dim rngC As Range
    Dim z As Long
    Dim s As String
    Dim words As Variant
    Dim c As Long
    
    Set d = CreateObject("Scripting.Dictionary")
    For Each rngC In ActiveSheet.Range("D4:D15000").SpecialCells(xlCellTypeVisible).Cells
        s = rngC.Value
        If Trim(s) <> "" Then
            words = Split(s, " ")
            c = 1
            For z = 0 To UBound(words)
                If Not d.exists(words(z)) Then
                    d.Add words(z), words(z)
                    rngC.Characters(Start:=c, Length:=Len(words(z))).Font.Color = RGB(255, 0, 0)
                End If
                c = c + Len(words(z)) + 1
            Next z
        End If
    Next rngC
    Set d = Nothing
End Sub