Newby Needs minor tweak on this VBA Macro code for Excel

[zulfer7]

bgeier did a lot to this code, it works perfectly now except for that the
comments don't add to an existing comment, they seem to be overwriting the
existing comment. Please help, this code will be used in a major application
for my company but cannot be used if I cannot get it to function. PLEASE
HELP!

Sub KeyCellsChanged()
Dim strDate As String
Dim cmt As Comment
Dim Username As String
Dim lName As Long

strDate = "ddmmmyy hh:mm"
Username = application.Username
Set cmt = ActiveCell.Comment
lName = 0

If cmt Is Nothing Then
Set cmt = ActiveCell.AddComment
With cmt
..Text (Username & " " & Format(Now, strDate) & Chr(10))
..Shape.TextFrame.Characters(1, Len(Username)).Font.Bold = True
End With
Else
Set cmt = ActiveCell.Comment
With cmt
..Shape.TextFrame.Characters(1, Len(cmt.Text)).Font.Bold = False
..Text ("")
..Text (Username)
..Shape.TextFrame.Characters(1, Len(Username)).Font.Bold = True
..Text (cmt.Text & " " & Chr(10) & Format(Now, strDate))
..Shape.TextFrame.Characters(Len(Username) + 1, Len(strDate) + 2).Font.Bold =
False
End With
End If
End Sub

 

[Jim Cone]

Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware

Sub KeyCellsChanged()
Dim strDate As String
Dim cmt As Excel.Comment
Dim Username As String
Dim lngLen As Long

strDate = "ddmmmyy hh:mm"
Username = Application.Username
Set cmt = ActiveCell.Comment

If cmt Is Nothing Then
Set cmt = ActiveCell.AddComment
With cmt
.Text (Username & " " & Format(Now, strDate) & Chr(10))
.Shape.TextFrame.Characters(1, Len(Username)).Font.Bold = True
End With
Else
With cmt
lngLen = Len(.Text)
.Shape.TextFrame.Characters(1, lngLen).Font.Bold = False
.Text Username, lngLen + 1
.Shape.TextFrame.Characters(lngLen + 1, 999).Font.Bold = True
lngLen = Len(.Text) + 1
.Text " " & Chr(10) & Format(Now, strDate) & Chr(10), lngLen
.Shape.TextFrame.Characters(lngLen, 999).Font.Bold = False
End With
End If
End Sub
'-------------



"zulfer7" <[email protected]>
wrote in message
bgeier did a lot to this code, it works perfectly now except for that the
comments don't add to an existing comment, they seem to be overwriting the
existing comment. Please help, this code will be used in a major application
for my company but cannot be used if I cannot get it to function. PLEASE
HELP!

Sub KeyCellsChanged()
Dim strDate As String
Dim cmt As Comment
Dim Username As String
Dim lName As Long

strDate = "ddmmmyy hh:mm"
Username = application.Username
Set cmt = ActiveCell.Comment
lName = 0

If cmt Is Nothing Then
Set cmt = ActiveCell.AddComment
With cmt
..Text (Username & " " & Format(Now, strDate) & Chr(10))
..Shape.TextFrame.Characters(1, Len(Username)).Font.Bold = True
End With
Else
Set cmt = ActiveCell.Comment
With cmt
..Shape.TextFrame.Characters(1, Len(cmt.Text)).Font.Bold = False
..Text ("")
..Text (Username)
..Shape.TextFrame.Characters(1, Len(Username)).Font.Bold = True
..Text (cmt.Text & " " & Chr(10) & Format(Now, strDate))
..Shape.TextFrame.Characters(Len(Username) + 1, Len(strDate) + 2).Font.Bold =
False
End With
End If
End Sub