vba to re-position cell comments for selected range only

[chasoe]

Dear Sirs,

From time to time, my worksheets cell comments will mysteriously got strayed with comment box positions gone far far away, especially when filtering is in place in the sheet.
I have searched the Internet for the following codes which runs fine for re-positioning cell comments for whole sheet :

Sub ResetSheetCommentBoxPosition()
            
'Reset Comment box to Original Position FOR WHOLE SHEET

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
            
End Sub

But when I cannot modify the codes for selected range of cells :

Dim cmtx As Comment
Dim WorkRng1 As Range

For Each cmtx In WorkRng1.Comment
    cmtx.Shape.Top = cmtx.Parent.Top + 5
    cmtx.Shape.Left = cmtx.Parent.Offset(0, 1).Left + 5
Next
           
End Sub

Would appreciate if anyone could help.

Many thanks.

 

[Fluff]

Are you looking to select a range of cells before running the code, or do you want to hardcode the range?

 

[chasoe]

Yes, correct, I just want to first highlight the desired range (some with comment boxes or while some may not), and then apply the codes on selected range only.

The first set of codes on whole sheet is OK. The second set of codes on selected range is my modification but doesn't work, and will be stuck on the third line.

The reason for only applying to selected range is that, when I'm focussing on a particular area in the sheet and want to read the details in the comment box but they have been placed outside the screen area for unknown reason. I don't want to spend time to scroll up / down / left / right to locate the box position. So the quickest way is to reset these comment boxes to my desired default position which is desirably close to the cell.

Should be simple to experts, but I've racked my brain without success.

 

[Norie]

Try this.

Dim cmtx As Comment
Dim WorkRng1 As Range

    Set WorkRng1 = Selection

    For Each cmtx In ActiveSheet.Comments

        If Not Intersect(WorkRng1, cmtx.Parent) Is Nothing Then
            cmtx.Shape.Top = cmtx.Parent.Top + 5

            cmtx.Shape.Left = cmtx.Parent.Offset(0, 1).Left + 5
        End If

    Next cmtx

[/code]

 

[chasoe]

I've tried and tested perfect.
Thank you indeed.