The current code is isolating notes created. Need to copy paste two additional cells in the row where the note is located. Any assistance would be greatly appreciated. The data in the active sheet, columns "D" and "F" are where the "CONFIGURATION INSTANCE" & "SUPPORT GROUP" are located.
VBA Code:
Sub LIST_NOTES()
Dim liComment As Comment
Dim i As Integer
Dim ws As Worksheet
Dim ComSh As Worksheet
Set ComSh = ActiveSheet
If ActiveSheet.Comments.Count = 0 Then Exit Sub
For Each ws In Worksheets
If ws.Name = "Comments" Then i = 1
Next ws
If i = 0 Then
Set ws = Worksheets.Add(After:=ActiveSheet)
ws.Name = "AFTER ACTION REPORTING"
Else: Set ws = Worksheets("Comments")
End If
For Each liComment In ComSh.Comments
ws.Range("A1").Value = "LOCATED IN CELL"
ws.Range("B1").Value = "AUTHOR"
ws.Range("C1").Value = "NOTE"
ws.Range("D1").Value = "CONFIGURATION INSTANCE"
ws.Range("E1").Value = "SUPPORT GROUP"
With ws.Range("A1:E1")
.Font.Bold = True
.Interior.Color = RGB(189, 215, 238)
.Columns.ColumnWidth = 40
End With
If ws.Range("A2") = "" Then
ws.Range("A2").Value = liComment.Parent.Address
ws.Range("B2").Value = Left(liComment.Text, InStr(1, liComment.Text, ":") - 1)
ws.Range("C2").Value = Right(liComment.Text, Len(liComment.Text) - InStr(1, liComment.Text, ":"))
Else
ws.Range("A1").End(xlDown).Offset(1, 0) = liComment.Parent.Address
ws.Range("B1").End(xlDown).Offset(1, 0) = Left(liComment.Text, InStr(1, liComment.Text, ":") - 1)
ws.Range("C1").End(xlDown).Offset(1, 0) = Right(liComment.Text, Len(liComment.Text) - InStr(1, liComment.Text, ":"))
End If
Next liComment
End Sub
Last edited by a moderator: