Help me with this macro

[bhandari]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Set cell = Range("B1")
If cell.Formula.Value = "=>5" Then
 cell.Offset(0, 0).AddComment "SUBSTRACT THEM"
 Else
 cell.Offset(0, 0).AddComment "ADD THEM"
End If
End Sub

my intention to add comment for targeting value
if the value is greater then 5 add "SUBSTRACT THEM" comment

 

[Scott T]

Try

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Set cell = Range("B1")
cell.ClearComments
If cell >= 5 Then
 cell.AddComment "SUBSTRACT THEM"
Else
 cell.AddComment "ADD THEM"
End If
End Sub

 

[bhandari]

Worked Perfectily

is it possible to set the comment box size?
its covering other cells

 

[Scott T]

You can have the comment box auto fit the comment or set the size of the box. Delete the code for the one you do not choose.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim xComment As Comment
Set cell = Range("B1")
cell.ClearComments
If cell >= 5 Then
 cell.AddComment "SUBSTRACT THEM"
Else
 cell.AddComment "ADD THEM"
End If

[COLOR=#006400]'autosize comment box[/COLOR]
Range("B1").Comment.Shape.TextFrame.AutoSize = True

[COLOR=#006400]' to set a size of the comment box[/COLOR]
With Range("B1").Comment.Shape
    .Width = 100
    .Height = 100
End With
 
End Sub

 

[bhandari]

Thats great ,Worked perfctly

one more Question

is it possible to fix text boxes like this?
Text boxes are part of my code

i can right only write 3 digits in text box
if i right 4 digits one digit is missing
can we set width and height for Text Boxes

 

[Scott T]

maybe

Note: this will change all shapes with text.

Sub TextBoxResizeAll()
Dim sh As Shape

    For Each sh In Sheets("Sheet6").Shapes
        With sh.TextFrame2
            .AutoSize = msoAutoSizeShapeToFitText
            .WordWrap = False
        End With
    Next sh

End Sub

 

[bhandari]

i have given name to Text Boxes
Text Boxes names are GOZ,GOY,GOX
GOZ1
GOZ2
GOZ3
GOY1
GOY2
GOY3
GOX1
GOX2
GOX3
in sheet 1

can you please make a macro for this only this text boxes names
AutoSize = msoAutoSizeShapeToFitText
here my macro stopped
Specified value is out of range
Object doesn't support this property or Method

 

[Scott T]

Try

Sub TextBoxResizeAll()
Dim sh As Shape
    For Each sh In Sheets("Sheet1").Shapes
        If sh.Name = "GOZ1" Or sh.Name = "GOZ2" Or sh.Name = "GOZ3" Or sh.Name = "GOY1" Or sh.Name = "GOY2" Or sh.Name = "GOY3" Or sh.Name = "GOX1" Or sh.Name = "GOX2" Or sh.Name = "GOX3" Then
        
            With sh.TextFrame2
                .AutoSize = msoAutoSizeShapeToFitText
                .WordWrap = False
            End With
        End If
    Next sh
End Sub