Add Text to all Existing Notes "Formerly known as Comments" in Merged Cells using VBA code

Sorry to keep bothering you I have one last problem when I add notes to the selected ranges it adds notes to the cells that are not merged, is there a command to keep this from happening I need it to add notes to just the merged cells that the user selects on the on-screen keyboard.

thanks again!

I'm currently using an input box for the user to make the selection

Here is my full code

Sub My_NoteReplace_InputBox()


Dim xRg As Range
Dim xRgEach As Range
Dim xAddress As String
Dim xText As String
'On Error Resume Next

' This let's you select the Range of Cells to change
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select a range:", "Kutools For Excel", xAddress, , , , , 8)

If xRg Is Nothing Then Exit Sub
If xRg.Count > 1 Then
Set xRg = xRg.SpecialCells(xlCellTypeVisible)
End If

' This is where you enter what you want the Notes to have in them
xRg.Select
xText = InputBox("Enter Comment to Add" & vbCrLf & "Comment will be added to all cells in Selection: ", "Kutools For Excel")

If xText = "" Then
MsgBox "No comment added", vbInformation, "Kutools For Excel"

If xRg.Select.MergeCells = False Then
With xRgEach
.DeleteComment
End With

End If

Exit Sub

End If

For Each xRgEach In xRg


With xRgEach
.ClearComments
.AddComment
End With

Next xRgEach


' This Macro will change all Note Comments to Transparent Blue Background & Bold White Text
CommentCount = 0
Dim MyComments As Comment
Dim LArea As Long
Dim fixed As Boolean
fixed = False

For Each MyComments In ActiveSheet.Comments
With MyComments
' .Shape.Fill.OneColorGradient msoGradientDiagonalUp, 1, 0.23
.Shape.AutoShapeType = msoShapeRoundedRectangle
.Shape.TextFrame.Characters.Font.Name = "Arial"
.Shape.TextFrame.Characters.Font.Size = 12
.Shape.TextFrame.Characters.Font.ColorIndex = 2
.Shape.Line.ForeColor.RGB = RGB(0, 0, 0)
.Shape.Line.BackColor.RGB = RGB(255, 255, 255)
.Shape.Fill.Visible = msoTrue
.Shape.TextFrame.Characters.Font.Bold = True
.Shape.Fill.BackColor.RGB = RGB(58, 82, 184)

' This fills background color of the Note and sets the transarancey to 0.04
.Shape.Fill.ForeColor.RGB = RGB(85, 85, 110)
.Shape.Fill.Transparency = 0.04

'This Sets the With & Height of each Note Comment Hotkey
MyComments.Shape.Width = 200
MyComments.Shape.Height = 40

CommentCount = CommentCount + 1

' this clears the text from all of the Notes
.Shape.TextFrame.Characters.Text = ""

'This Adds Text to all the Notes
'.Text Text:=.Text & "Add Note here!"

End With
Next 'comment


If CommentCount > 0 Then
'MsgBox ("A total of " & CommentCount & " comments in worksheet '" & MySheet.Name & "' of workbook '" & MyWorkbook.Name & "'" & Chr(13) & "were repositioned and resized.")

MsgBox ("A Total Of " & CommentCount & "" & "Were change")

fixed = True
End If



If fixed = False Then
MsgBox ("No comments were detected.")
End If

On Error GoTo 0

Exit Sub
End Sub

I ran your code but I got an error
error.jpg
do you know what is wrong?
do I need to define something in a Dim?

that worked great!!! thank you so much I have been working on this for days now
is there a rating system on this forum so I can give you a 10 out of 10 Stars

thanks again ByteMarks your the best!!!

I would love to give back to the forum for helping me
does the forum allow us to upload an Excel File to share with others?
if not I could host it in my Gdrive or something.