paste comment text to right of cell

S

shadowsong

i'm trying to paste comment text to the right of the commented cell,
but first i need to insert blank columns in which comments can be
pasted.

the macro is supposed to select all cells with comments, change the
selection all columns with comments, insert a new column to the right
of the selections, and paste the comment text (minus username) into the
new blank cell.

the rest of the macro works, but when i try to insert new columns to
the right of the selection i get an error 1004: cannot use that command
on overlapping sections. any ideas? here's what i have so far:

Sub comment_macro()

Dim CommentCells As Range
Dim MyCell As Range

ActiveSheet.UsedRange.SpecialCells(xlCellTypeComments).Select

Set CommentCells = Selection

Selection.EntireColumn.Select
Selection.Insert Shift:=xlToLeft

CommentCells.Select

For Each MyCell In CommentCells
MyCell.Offset(0, 1).Value = Mid$(MyCell.Comment.Text,
InStr(MyCell.Comment.Text, ":") + 1)
Next MyCell

End Sub
 
R

Ron de Bruin

Try this with Offset

Range("A1").CurrentRegion.Select
Selection.SpecialCells(xlCellTypeComments).Select
Selection.Offset(0, 1).EntireColumn.Insert
 
S

shadowsong

Ah, offset! That's what i needed to insert the columns in the right
place...

Unfortunately, I still can't actually insert anything - it's still
giving me the "overlapping selections" error. I do have multiple
comments in many columns - is that what's causing the error? If so, how
do I fix it?

Instead of selecting all comments, should I try searching each column
for comments and then offsetting and inserting? I'm making up syntax
and functions as I go, but something like,

For Each MyColumn in ActiveSheet
If MyColumn.SpecialCells(xlCellTypeComments).Count > 1,
MyColumn.Select
Selection.Offset(0, 1).EntireColumn.Insert
Next MyColumn

I think there's an AreaCount function that does this, but I'm not sure
exactly how.
 
R

Ron de Bruin

Try this for 100 columns

Sub test()
Dim a As Integer
Dim Ccount As Long

For a = 100 To 1 Step -1
On Error Resume Next
Ccount = Columns(a).SpecialCells(xlCellTypeComments).Count
If Err.Number > 0 Then
Err.Clear
Else
Columns(a).Offset(0, 1).EntireColumn.Insert
End If
On Error GoTo 0
Next

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top