Macro to automatically add comment boxes

[lawlegge]

Greetings;

I am using this macro to add comment boxes, containing specific text, to worksheets. I have columns 'A' to 'E' frozen and only add to columns 'F' and beyond by manually setting the 'Range' as needed.

Sub AddACTS_CONS_RANGE()
Dim ocel As Range
On Error Resume Next
For Each ocel In ActiveSheet.Range("F2:AC100")
  ocel.AddComment.Text Text:="ACTS:" & Chr(10) & Chr(10) & "" & Chr(10) & "CONS:" & Chr(10) & Chr(10) & ""
  ocel.Comment.Shape.TextFrame.Characters(1, 5).Font.Bold = True
  ocel.Comment.Shape.TextFrame.Characters(9, 5).Font.Bold = True
  ocel.Comment.Shape.TextFrame.AutoSize = True
Next
End Sub

What I would like it to do is:
- only add comment boxes to rows that contain '.wag' (that is-dot wag) in column 'E' - thus leaving all other rows UN-commented.

Thanking you in advance,
lawlegge

[jraj1106]

Hi Lawlegge.

Try this code:

Sub AddACTS_CONS_RANGE()
    Dim ocel As Range, rcnt As Long, i As Long
    On Error Resume Next
    
    rcnt = Range("E" & Rows.Count).End(xlUp).Row
    
    For i = 2 To rcnt
        If InStr(1, ActiveSheet.Range("E" & i), ".wag") > 0 Then
            For Each ocel In ActiveSheet.Range("F" & i & ":AC" & i)
                ocel.AddComment.Text Text:="ACTS:" & Chr(10) & Chr(10) & "" & Chr(10) & "CONS:" & Chr(10) & Chr(10) & ""
                ocel.Comment.Shape.TextFrame.Characters(1, 5).Font.Bold = True
                ocel.Comment.Shape.TextFrame.Characters(9, 5).Font.Bold = True
                ocel.Comment.Shape.TextFrame.AutoSize = True
            Next
        End If
    Next
End Sub

[lawlegge]

Thank you 'jraj1106'...that is exactly what I was looking for.

Just one question - I am constantly updating my worksheets alphabetically, inserting x number of rows wherever needed. How can I specify, using this code, to comment only the newly inserted rows ?

[jraj1106]

Hi.

Thanks for your feedback.

This is the modified version of the code:

Dim prevrow As Long

Sub AddACTS_CONS_RANGE()
    Dim ocel As Range, rcnt As Long, i As Long
    
    On Error Resume Next
    rcnt = Range("E" & Rows.Count).End(xlUp).Row
    
    For i = prevrow + 1 To rcnt
        If InStr(1, ActiveSheet.Range("E" & i), ".wag") > 0 Then
            For Each ocel In ActiveSheet.Range("F" & i & ":AC" & i)
                ocel.AddComment.Text Text:="ACTS:" & Chr(10) & Chr(10) & "" & Chr(10) & "CONS:" & Chr(10) & Chr(10) & ""
                ocel.Comment.Shape.TextFrame.Characters(1, 5).Font.Bold = True
                ocel.Comment.Shape.TextFrame.Characters(9, 5).Font.Bold = True
                ocel.Comment.Shape.TextFrame.AutoSize = True
                prevrow = rcnt
            Next
        End If
    Next
End Sub

Here you can see a variable "prevrow" which is declared outside the sub. This will determine the last row where the comment box was entered. So comment box will be entered from that previous position to all the new records that you had entered. Hope this solves your problem.

Thanks again.

[lawlegge]

Thank You again jraj1106 for your time...this works perfectly...

One more small tweak...
99% of my worksheets - I need to exclude 'Row 1' as this row acts as my header and is frozen.
1% of my worksheets - I need to exclude 'Rows 1-9' as these rows act as my header and are frozen.

note: it seems this macro will only run once in a worksheet - To have it run a second time, I must close (and save) and reopen. Any ideas...