Belonging Row is not clear in Code

Hi @ all,

I have the following Code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("K:K")) Is _
    Nothing Then Exit Sub

Dim myRange As Range
Dim rngZelle As Range
Dim k As Range
Dim strComment As String
Dim Tag As String
Dim LRow As Long

Loeschen

Set myRange = Sheets("Sheet1").Range("A4:NB4")

With Sheets("Sheet2")
    LRow = .Cells(.Rows.Count, 26).End(xlUp).Row
End With

For Each k In Range("K3:K" & LRow)
For Each rngZelle In myRange

With rngZelle
    If .Value <= k And _
        .Value >= k.Offset(0, -1) Then
        .Interior.ColorIndex = 3
        .Font.ColorIndex = 3
    End If
    If .Value = k Then
        If Not .Comment Is Nothing Then
            .Comment.Delete
        End If
        strComment = k.Offset(0, -6)
        .AddComment strComment
        .Comment.Visible = True
        .Comment.Shape.TextFrame.AutoSize = True
        Sheets("Sheet1").Select
        .Comment.Shape.Select True
        Selection.ShapeRange.Top = 100
        Selection.ShapeRange.Left = .Left
    End If
End With
Next rngZelle
Next k

End Sub

Situation:

This code marks given events in "K" in a timeline at the right place in the year - okay!
But unfortunately it does not only mark the given date (inrow "k") in the timeline. It marks the whole timeline...


Would you be so kind to adopt the code that only the date which is given in row "K" is marked?
It is not necessary to mark a period. It should just show what is in row "K".


Thank you in advance from Germany