Excel 2007 Comment Box Deleting all instances of blank lines

To do this to all cells

Sub str8commnt()
    Dim cel As Range
    For Each cel In ActiveSheet.UsedRange.Cells
        If Not cel.Comment Is Nothing Then
            cel.Comment.Text Text:=Replace(cel.Comment.Text, vbCr, "")
            cel.Comment.Text Text:=Replace(cel.Comment.Text, vbLf, "")
        End If
    Next cel
End Sub

Select allOpen in new window

For activecell

            activecell.Comment.Text Text:=Replace(cel.Comment.Text, vbCr, "")
            activecell.Comment.Text Text:=Replace(cel.Comment.Text, vbLf, "")

Select allOpen in new window

Thanks for the above code but what it is doing is stripping out all of the vbcr and vblf which means that all of my comments that started on individual lines all end up on the same line. like comment1comment2comment4

Can you amend your code so that it works on a comment box in an  active cell and if I started with say

comment 1
comment 2

comment 4

I would end up with

comment 1
comment 2
comment 4

Many thanks

I am still ending up when I ultimately delete all of my comments with a comment box that has one or two empty lines still in it.

Is there a check that you could build in to say that if the comment box was empty of text then delete the comment box even though there might be at least one empty line or two.

Thanks for the help so far.

Can you upload a sample file (with fake data) so that I can see all the variations in it. There might be vblf's, vbcr's vbcrlf's or combinations. You should be able to try out the combinations yourself or upload something for us to see.

Meanwhile try replacing

            Do While InStr(cel.Comment.Text, vbLf & vbLf) > 0
                cel.Comment.Text Text:=Replace(cel.Comment.Text, vbLf & vbLf, vbLf)
            Loop

with

                cel.Comment.Text Text:=Replace(cel.Comment.Text, vbLf & vbLf, vbLf)
                cel.Comment.Text Text:=Replace(cel.Comment.Text, vbLf & vbcr, vbLf)
                cel.Comment.Text Text:=Replace(cel.Comment.Text, vbcr & vbcr, vbLf)
                cel.Comment.Text Text:=Replace(cel.Comment.Text, vbcr & vbLf, vbLf)

You might have to run the program more than once before all of them are gone.

Have attached file for you to look at ...as you can see, when you run the code I am left with the top line blank which I cannot get rid of.

Code to get rid of the box when all of the text comments are deleted would be good even if there were blank lines still in the comment box.

Looks like the file did not make its way through.

Meanwhile try adding these lines after the above ones.

if left(cel.comment.text,1)=vbcr then cel.Comment.Text Text:=right(cel.comment.text,len(cel.comment.txt)-1)
if left(cel.comment.text,1)=vblf then cel.Comment.Text Text:=right(cel.comment.text,len(cel.comment.txt)-1)

Select allOpen in new window

I expect the macro didn't get past the firewall...never mind I have got it working the best I can so I will close the question and thank you for your efforts.

I do not think this site is as clever as it used to be in its electronic handling...much slower and not so easy to move around but the experts are still good.