macro to run in active cell only, not whole worksheet

[Annie62]

Hi All,

I grabbed this macro code, and it works perfectly, except for one thing, the macro runs on the whole worksheet and I need it to run on only the active cell.

I’ve tried adjusting ActiveWorkbook, with ActiveCell, Worksheet with Cell, and a few other things, but nothing seems to work (I’m still a newbie). My thinking was I need to recode something(s) in the first several lines of the below code. Any help is greatly appreciated.


Sub CommentTheHeckOuttaIt()
Dim ws As Worksheet
Dim iCell As Range
For Each ws In ActiveWorkbook.Worksheets
For Each iCell In ws.UsedRange
With iCell
If CStr(.Value) <> "" Then
.ClearComments
.AddComment
.Comment.Visible = False
.Comment.Text Text:=CStr(.Value)
.Comment.Shape.ScaleWidth 3.87, msoFalse, msoScaleFromTopLeft
.Comment.Shape.ScaleHeight 2.26, msoFalse, msoScaleFromTopLeft
End If
If .Formula <> "" Then
.ClearComments
.AddComment
.Comment.Visible = False
.Comment.Text Text:=CStr(.Formula)
.Comment.Shape.ScaleWidth 3.87, msoFalse, msoScaleFromTopLeft
.Comment.Shape.ScaleHeight 2.26, msoFalse, msoScaleFromTopLeft
End If
End With
Next
Next
End Sub


What I am trying to accomplish is…
Run the macro on single/active cell (example C8), then hover over the comment box for cell (C8), the comment box for cell then shows me the text that is in that specific cell.

Thank You,
Annie62

 

[offthelip]

try this:

Sub CommentTheHeckOuttaIt()
Dim ws As Worksheet
Dim iCell As Range
'For Each ws In ActiveWorkbook.Worksheets
'For Each iCell In ws.UsedRange
With Selection
If Selection.Cells.Count = 1 Then
If CStr(.Value) <> "" Then
.ClearComments
.AddComment
.Comment.Visible = False
.Comment.Text Text:=CStr(.Value)
.Comment.Shape.ScaleWidth 3.87, msoFalse, msoScaleFromTopLeft
.Comment.Shape.ScaleHeight 2.26, msoFalse, msoScaleFromTopLeft
End If
If .Formula <> "" Then
.ClearComments
.AddComment
.Comment.Visible = False
.Comment.Text Text:=CStr(.Formula)
.Comment.Shape.ScaleWidth 3.87, msoFalse, msoScaleFromTopLeft
.Comment.Shape.ScaleHeight 2.26, msoFalse, msoScaleFromTopLeft
End If
End If
End With
'Next
'Next
End Sub

 

[Yongle]

or this

Sub CommentTheHeckOuttaIt()
    With ActiveCell
        If CStr(.Value) <> "" Then
            .ClearComments
            .AddComment
            .Comment.Visible = False
            .Comment.Text Text:=CStr(.Value)
            .Comment.Shape.ScaleWidth 3.87, msoFalse, msoScaleFromTopLeft
            .Comment.Shape.ScaleHeight 2.26, msoFalse, msoScaleFromTopLeft
        End If
        If .Formula <> "" Then
            .ClearComments
            .AddComment
            .Comment.Visible = False
            .Comment.Text Text:=CStr(.Formula)
            .Comment.Shape.ScaleWidth 3.87, msoFalse, msoScaleFromTopLeft
            .Comment.Shape.ScaleHeight 2.26, msoFalse, msoScaleFromTopLeft
        End If
    End With
End Sub

 

[MickG]

Perhaps this:-
NB:- Change Target.address in code to suit.!!
NB:- This is a selection Change event, Place in Activesheet Module :- Alt+F11> Vb window appears > Paste in Vbwindow.

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_SelectionChange(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]If[/COLOR] Target.Address(0, 0) = "C8" [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]With[/COLOR] Target
    [COLOR="Navy"]If[/COLOR] CStr(.Value) <> "" [COLOR="Navy"]Then[/COLOR]
        .ClearComments
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=CStr(.Value)
        .Comment.Shape.ScaleWidth 3.87, msoFalse, msoScaleFromTopLeft
        .Comment.Shape.ScaleHeight 2.26, msoFalse, msoScaleFromTopLeft
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]If[/COLOR] .HasFormula [COLOR="Navy"]Then[/COLOR]
        .ClearComments
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=CStr(.Formula)
        .Comment.Shape.ScaleWidth 3.87, msoFalse, msoScaleFromTopLeft
        .Comment.Shape.ScaleHeight 2.26, msoFalse, msoScaleFromTopLeft
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Annie62]

Works Prefect Thank You