Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("K4:K5000")) Is Nothing Then Exit Sub
Dim Nm$, L&, s$, v
Nm = Application.UserName: s = "Иванов А.: Андреев П.:": L = 1
With Target
     .Value = .Value & IIf(Len(.Value), vbLf, vbNullString) & Now & " " & Nm & ": "
     For Each v In Split(.Value, vbLf)
         .Characters(L, Len(v)).Font.Color = IIf(InStr(s, Split(v)(2)), vbBlue, vbBlack)
         L = L + Len(v) + 1
     Next
End With
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'включаем действие по клику
          If Not Intersect(Target, Range("K4:K5000")) Is Nothing Then 'включаем макрос для данного диапазона ячеек
              With Target(1, 1) 'указываем, с какой ячейкой работать макросу
                  If IsEmpty(Target) Then 'если ячейка изначально пуста, то включаем макрос без перевода на новую строку
                  .Value = Now & " " & Application.UserName & ": "
                  Else 'в противном случае - перевод на новую строку будет
                  .Value = .Value & vbLf & Now & " " & Application.UserName & ": "
                  End If              
              End With
          End If
Cancel = 0
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("K4:K5000")) Is Nothing Then Exit Sub
Dim Nm$, L&, s$, i&, sp, t() 't(40, 2)
With Application
     Nm = .UserName: .ScreenUpdating = False
End With
L = 1: s = "Иванов А.: Андреев П.:"
With Target
     sp = Split(.Value, vbLf): ReDim t(UBound(sp), 2)

     For i = 0 To UBound(sp)
         With .Characters(L, Len(sp(i))).Font
             t(i, 0) = .Bold: t(i, 1) = .Size: t(i, 2) = .Color
         End With
         L = L + Len(sp(i)) + 1
     Next

     .Value = .Value & IIf(Len(.Value), vbLf, vbNullString) & Now & " " & Nm & ": "
     L = 1
     For i = 0 To UBound(sp)
         With .Characters(L, Len(sp(i))).Font
             .Bold = t(i, 0): .Size = t(i, 1): .Color = t(i, 2)
         End With
         L = L + Len(sp(i)) + 1
     Next
     .Characters(L).Font.Color = IIf(InStr(s, Nm), vbBlue, vbBlack)
End With
Application.ScreenUpdating = False
End Sub

sp = Split(.Value, vbLf): ReDim t(UBound(sp), 2)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("K4:K5000")) Is Nothing Then Exit Sub
Dim Nm$, L&, s$, i&, sp, t(40, 2) '  t(40, 2) - не более 41 строки!
With Application
     Nm = .UserName: .ScreenUpdating = False
End With
L = 1: s = "Иванов А.: Андреев П.:"
With Target
     sp = Split(.Value, vbLf)

     For i = 0 To UBound(sp)
         With .Characters(L, Len(sp(i))).Font
             t(i, 0) = .Bold: t(i, 1) = .Size: t(i, 2) = .Color
         End With
         L = L + Len(sp(i)) + 1
     Next

     .Value = .Value & IIf(Len(.Value), vbLf, vbNullString) & Now & " " & Nm & ": "
     L = 1
     For i = 0 To UBound(sp)
         With .Characters(L, Len(sp(i))).Font
             .Bold = t(i, 0): .Size = t(i, 1): .Color = t(i, 2)
         End With
         L = L + Len(sp(i)) + 1
     Next
     .Characters(L).Font.Color = IIf(InStr(s, Nm), vbBlue, vbBlack)
End With
Application.ScreenUpdating = False
End Sub