Search for cells with comments and cocatatenate to Col(N)

[frank_m]

I need to scan all cells in a sheet and delete any cell coments, but keep their text by cocatenating to Col(Q) value.
Something to this effect, but combined with the code shown below it, to be as efficient as possible.
Edit: Changed Col(N) to Col(Q)
[vba]
Dim c As Range
For Each c In rng
If Not (c.Comment Is Nothing) Then
With c.EntireRow.Cells(17)
.Value = .Value & " (Note from Column(" & c.Column & ") " & Trim(c.Comment.Text)
.WrapText = False
c.Comment.Delete
End With
End If
Next c
[/vba]
[vba]
Private Sub CommandButton1_Click()
'Written by p45cal
'http://www.vbaexpress.com/forum/show...t=39950&page=2

Dim j As Integer
Dim rng As Range, colm As Range
Dim LastRow As Long
'On Error Resume Next
'Application.EnableCancelKey = xlDisabled
With ActiveSheet
.DisplayAutomaticPageBreaks = False
LastRow = .Range("D" & Rows.Count).End(xlUp).Row
Set rng = .Range("A17:AD" & LastRow)
Application.ScreenUpdating = False
Application.EnableEvents = True
'Scan all the rows' cell formatting, and make changes if necessary, to match those found in row 16
'- if background color is white, change to xlnone
For Each colm In rng.Columns
j = colm.Column
If Not j = 14 Then ' skip processing column 14
colm.NumberFormat = .Cells(16, j).NumberFormat
colm = Application.Trim(colm)
colm.HorizontalAlignment = .Cells(16, j).HorizontalAlignment
colm.VerticalAlignment = .Cells(16, j).VerticalAlignment
colm.WrapText = .Cells(16, j).WrapText
colm.Orientation = .Cells(16, j).Orientation
colm.AddIndent = .Cells(16, j).AddIndent
colm.IndentLevel = .Cells(16, j).IndentLevel
colm.ShrinkToFit = .Cells(16, j).ShrinkToFit
colm.Font.Name = .Cells(16, j).Font.Name
colm.Font.Size = .Cells(16, j).Font.Size
colm.Value = colm.Value
'line above ensures Excel will recognize if the cell format is changed here.
If j = 1 Then
With Application
.FindFormat.Clear
.ReplaceFormat.Clear
.FindFormat.Interior.ColorIndex = 3
.ReplaceFormat.Font.ColorIndex = 2
colm.Replace What:="", Replacement:="", LookAt:=xlPart, _
MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
.FindFormat.Clear
.ReplaceFormat.Clear
End With
End If
End If
Next colm
End With

With Application
.FindFormat.Clear
.ReplaceFormat.Clear
.FindFormat.Interior.ColorIndex = 2
.ReplaceFormat.Interior.ColorIndex = xlNone
rng.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
.FindFormat.Clear
.ReplaceFormat.Clear
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub
[/vba]