VBA: Auto Format Comments

itsmekarak

New Member
Joined
Sep 29, 2014
Messages
30
Hello all,

A large part of my workday involves reviewing worksheets containing comments. Some comments are formatted perfectly whereas others need resizing. In turn I find myself doing the same activity over and over again to format them; which led me to discover this auto formatting macro:

Sub AutoFormatComments()


Dim MyComments As Comment
Dim lArea As Long


For Each MyComments In ActiveSheet.Comments
With MyComments
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 150 Then
lArea = .Shape.Width * .Shape.Height
'Width of 150 gets me as close to 9.26cm as feasible
.Shape.Width = 150
.Shape.Height = (lArea / 150) * 0.75
End If
End With
Next ' comment


Dim cmt As Comment
For Each cmt In ActiveSheet.Comments
cmt.Shape.Top = cmt.Parent.Top + 5
cmt.Shape.Left = _
cmt.Parent.Offset(0, 1).Left + 5
Next ' comment

End With
Next 'comment
End Sub

This is a fantastic script in that it sets the width of the comment and then auto adjusts for the height base on the amount of text. It would be perfect if it could just include these additional features:


  1. Run for only one cell instead of all cells in a worksheet
  2. Change the font to the following:
    • Choose Calibri for the font
    • Choose Bold for the font style
    • Choose size 9 for the font size
    • Choose Red for the font color on the 1st line only
    • Choose Black for the font color for all remaining text
  3. Set it to move but don't size with cells
  4. Set it to a keyboard shortcut of Ctrl + T

Can someone assist with modifying this macro? Thank you in advance for any and all help!

Sincerely,
Kara
 

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

ParamRay

Well-known Member
Joined
Aug 6, 2014
Messages
1,195
Add the following code to your existing procedure. You need to assign the keyboard shortcut yourself.
Code:
Public Sub FormatTextBox()
  ' Procedure to adjust the properties of
  ' the selected comment. Also works with
  ' other textboxes.
  
  Dim intLinefeed As Integer
  Dim intLength As Integer
  Dim TB As TextBox
  
  ' Exit if selection is not a textbox
  If Not TypeOf Selection Is TextBox Then Exit Sub
  
  ' Set font to calibri, bold, size 9
  Set TB = Selection
  TB.Font.Name = "Calibri"
  TB.Font.Bold = True
  TB.Font.Size = 9
  
  ' Get length of text and position of linefeed
  intLength = Len(TB.Text)
  intLinefeed = InStr(1, TB.Text, vbLf)
  
  ' Set first line of text to red font, remaining text to black font
  If intLinefeed > 0 Then TB.Characters(1, intLinefeed - 1).Font.Color = vbRed
  TB.Characters(intLinefeed + 1, intLength - intLinefeed).Font.Color = vbBlack
  
  ' Set placement to move but don't size
  TB.Placement = xlMove
  
  Set TB = Nothing
End Sub
 

ParamRay

Well-known Member
Joined
Aug 6, 2014
Messages
1,195
Forgot to mention that you can set the height, width, top and left of the textbox in the same way you did before, by using TB.Height = ..., TB.Width = ..., etc. You can also set the AutoSize property by using TB.AutoSize = True. So you can incorporate everything you had before into this macro.
 

itsmekarak

New Member
Joined
Sep 29, 2014
Messages
30
Thank you for your help. Unfortunately, the font did not change to Calibri and the first line isn't a red color. Also, when I view the properties of the comment it doesn't show that it's been changed from the default to move but don't size. I must have done something wrong when combining the scripts. Here it is in its entirety for your review. Thank you again for your help. It's greatly appreciated!

Sub Fixed_Width_Format_Comments()

Dim MyComments As Comment
Dim lArea As Long


For Each MyComments In ActiveSheet.Comments
With MyComments
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 150 Then
lArea = .Shape.Width * .Shape.Height
'Width of 150 gets me as close to 9.26cm as feasible
.Shape.Width = 150
.Shape.Height = (lArea / 150) * 0.75
End If
End With
Next ' comment


Dim cmt As Comment
For Each cmt In ActiveSheet.Comments
cmt.Shape.Top = cmt.Parent.Top + 5
cmt.Shape.Left = _
cmt.Parent.Offset(0, 1).Left + 5
Next ' comment

Dim intLinefeed As Integer
Dim intLength As Integer
Dim TB As TextBox

' Exit if selection is not a textbox
If Not TypeOf Selection Is TextBox Then Exit Sub

' Set font to calibri, bold, size 9
Set TB = Selection
TB.Font.Name = "Calibri"
TB.Font.Bold = True
TB.Font.Size = 9

' Get length of text and position of linefeed
intLength = Len(TB.Text)
intLinefeed = InStr(1, TB.Text, vbLf)

' Set first line of text to red font, remaining text to black font
If intLinefeed > 0 Then TB.Characters(1, intLinefeed - 1).Font.Color = vbRed
TB.Characters(intLinefeed + 1, intLength - intLinefeed).Font.Color = vbBlack

' Set placement to move but don't size
TB.Placement = xlMove

Set TB = Nothing


End Sub

 

ParamRay

Well-known Member
Joined
Aug 6, 2014
Messages
1,195

ADVERTISEMENT

Perhaps I didn't explain it very well! Replace everything with the following code instead.


Note that you need to select the comment before running the macro otherwise nothing will happen. In other words, don't just position the cursor inside the comment - actually SELECT the comment so that you can see the resizing handles on the corners and sides.


Code:
Public Sub FormatTextBox()
  ' Procedure to adjust the properties of
  ' the selected comment.
  
  Dim intLinefeed As Integer
  Dim intLength As Integer
  Dim TB As TextBox
  
  ' Exit if selection is not a textbox
  If Not TypeOf Selection Is TextBox Then Exit Sub
  
  ' Set font to calibri, bold, size 9
  Set TB = Selection
  TB.Font.Name = "Calibri"
  TB.Font.Bold = True
  TB.Font.Size = 9
  
  ' *** ADDED THIS SECTION *************************
  
    ' Automatically size to text
    TB.AutoSize = True
    
    ' Set to custom size
    If TB.Width > 150 Then
      TB.Width = 150
      TB.Height = 0.75 * (TB.Width * TB.Height) / 150
    End If
    
    ' Move to custom position
    Dim cmt As Comment
    For Each cmt In TB.Parent.Comments
      If cmt.Shape.Name = TB.Name Then
        TB.Top = cmt.Parent.Top + 5
        TB.Left = cmt.Parent.Offset(, 1).Left + 5
        Exit For
      End If
    Next cmt
    Set cmt = Nothing


  ' ************************************************
  
  ' Get length of text and position of linefeed
  intLength = Len(TB.Text)
  intLinefeed = InStr(1, TB.Text, vbLf)
  
  ' Set first line of text to red font, remaining text to black font
  If intLinefeed > 0 Then TB.Characters(1, intLinefeed - 1).Font.Color = vbRed
  TB.Characters(intLinefeed + 1, intLength - intLinefeed).Font.Color = vbBlack
  
  ' Set placement to move but don't size
  TB.Placement = xlMove
  
  Set TB = Nothing
End Sub
 

itsmekarak

New Member
Joined
Sep 29, 2014
Messages
30
Thank you for your help and patience. I replaced my script entirely with the script you provided and get a message "Run-time error '16': Expression too complex." When I click on the Debug option, I'm taken to this portion of the script...
TB.Height = 0.75 * (TB.Width * TB.Height) / 150. Any idea how I could repair this?

Thank you for your continued assistance.
 

ParamRay

Well-known Member
Joined
Aug 6, 2014
Messages
1,195
I think it's a glitch.

Try changing it to:

TB.Height = CSng((TB.Width * TB.Height) / 200)
 

itsmekarak

New Member
Joined
Sep 29, 2014
Messages
30
Hello,

Thank you so much for your continued help. The run-time error went away, but now it doesn't auto adjust. So I have a long comment,but it's only showing about a 200x300 pixel size box. The 200 pixels is perfect, but the 300 is limiting. Is there anything additional that an be done to repair this?
 

Watch MrExcel Video

Forum statistics

Threads
1,122,819
Messages
5,598,293
Members
414,223
Latest member
Accountant2B

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top