Delete empty rows in Excel comment using VBA

Question

I have a problem specifying specific information contained in Excel Cell Comments. I have multiple comments in multiple workbooks that total more than 1M so I am looking for a way that I can apply a routine to clean a workbook, then maybe incorporate it into Workbook_Open() for all of the workbooks.

Example Comment - There could be one blank row or twenty before the first line of text, between any two lines of text or after the last line of text.

**









May 8






June 1






**

I have a small routine that sort of does the trick.

Sub RemoveBlankCommentRows()
Dim c As Comment

For Each c In ActiveSheet.Comments
    c.Text Replace(c.Text, "" & Chr(10), " ")
    rng.Comment.Shape.TextFrame.AutoSize = True
Next c

End Sub

The only problem with this is that it puts all of the Comment data on a single row as indicated below.

**May 8  June 1**

What I would like is that it returned as indicated below, with or without the blank row between text:

**May 8

June 1**

What I am looking for is a way to distinguish between rows in the Comment that have text and those that have no visible text, but may have a space or several spaces, vbNull, vbNullChar, vbNullString or any other non-printable information. The problem that I am facing is to understand how to determine what line of the Comment is being looked at, or is it the Comment as a whole?

Any help on this would be most appreciated. I have searched everywhere I could and nothing has provided me a way to address the issue without putting all text in a single line.

Answer 1

A very basic approach, but try this:

Sub RemoveBlankCommentRows()
Dim c As Comment

For Each c In ActiveSheet.Comments
    If Len(c.Text) < 2 Then c.Text Replace(c.Text, "" & Chr(10), " ")
    rng.Comment.Shape.TextFrame.AutoSize = True
Next c

EDIT:

It will need to be modified a bit to be used in comments. It's been split into 3 like below for reasons particular to my use-case, but for macro-use (as in, for using it on larger areas) I've just created a button on the toolbar that calls cleanSpecialsFromSelection.

For this dataset, I deal with imported data that for reasons pertaining to what I can only assume is character encoding issues contains a lot of non-printable characters, and the results are perfect for me. It's not elegant, though - it relies on the most basic bruteforce approach, and for large datasets it will take time to complete. On my workstations, an 8x3000 selection will take close to 10 seconds.

Here's my code:

Global bannedChars As String

Sub cleanSpecialCharacters(Optional str As Range)
bannedChars = Chr(127) & "," & Chr(129) & "," & Chr(141) & "," & Chr(143) & "," & Chr(144) & "," & Chr(157) & "," & Chr(160)
Application.ScreenUpdating = False

If IsMissing(str) Then Set str = Range(Selection.Item(1).Address)

Dim tVal As String, bChar As Variant
tVal = str.Value

tVal = Application.WorksheetFunction.Clean(tVal)
tVal = Application.WorksheetFunction.Trim(tVal)

For Each bChar In Split(bannedChars, ",")
    tVal = Replace(tVal, bChar, "")
Next

If IsNumeric(tVal) Then
    str.Value = CLng(tVal)
Else
    str.Value = tVal
End If

Application.ScreenUpdating = True
End Sub


Sub cleanSpecialCharactersRange(str As Range)
    ' Argument passed to this sub should be >1 cell, otherwise call cleanSpecialCharacters() directly
    Dim c As Range
    For Each c In str.Cells
        Call cleanSpecialCharacters(c)
    Next
End Sub


Sub cleanSpecialsFromSelection()
    Dim rng As Range
    Set rng = Selection
    Call cleanSpecialCharactersRange(rng)
End Sub

Answer 2

SOLVED! I finally found the solution by using the Split function. It starts off with my standard code to speed things up and prevent unwanted error messages. This is a truly brute-force approach and I am sure that there is a more eloquent way to do this. But, this resolves all of the issues I was having with non-printable characters, spaces and the like. I now get each row of information retained in the row without large sections of blank lines before, after or in the middle of the rows of data.

Near the end I added some code to make the comments look better. The plain pale yellow gets very old, really quick. Hope someone else will have use for this in the future.

    Sub SplitCellComment()
    '   Using the vba Split function: return each substring, and its 
    '   length, on splitting a string; _
    '    number of occurrences of a character 
    '   (ie. delimiter) within a string;

        Dim Cmt As Excel.Comment
        Dim i As Integer
        Dim LArea As Long, xCmt As Long
        Dim sText As String, sChr As String
        Dim arr As Variant, varExp As Variant, varDelim As Variant

    '   Turn the following activity off to increase program speed.
        With Application
            .StatusBar = True
            .EnableEvents = False
            .DisplayAlerts = False
            .ScreenUpdating = False
        End With

        For Each Cmt In ActiveSheet.Comments
            sText = ""

    '       specify string expression which will be split into substrings:
            varExp = Cmt.Text

    '       specify delimiter for substrings:
            varDelim = Chr(10) '"s"

            arr = Split(varExp, varDelim)
    '       includes an array element representing a sub-string of zero- 
    '       length before the first character which is the delimiter.

            For i = LBound(arr) To UBound(arr)
    '       return each element of the array - these are the substrings into
    '       which the string expression is split into.

    '           Remove any spaces that may be present on blank rows.
                arr(i) = Trim(arr(i))

    '           If the left character of the first row = Chr(10) 
    '           then delete it.
                If Left(arr(0), 1) = Chr(10) Then Left(arr(0), 1) = ""

    '           If a row as a length of 0 then trim any spaces from the 
    '           ends. Otherwise add a Chr(10) after the text.
                If Len(arr(i)) = 0 Then
                    arr(i) = ""
                    sText = Trim(sText) & arr(i)
                Else
                    sText = Trim(sText) & Chr(10) & arr(i)
                End If

    '           Due to Chr(10) being inserted automatically at the 
    '           beginning of the text, this will remove the first character.
                If i = 0 Then
                    If Len(sText) <> Len(arr(0)) Then
                        sText = Mid(sText, 2, Len(sText))
                    End If
                End If

    '           In some cases the next If...Then is required to remove 
    '           non-printable characters.
                On Error Resume Next
                If Asc(Left(sText, 1)) < 32 Then sText = Mid(sText, 2, Len(sText))
                On Error GoTo 0
            Next i
            Cmt.Text sText

    '       Format comment shape, size and font.
            With Cmt
    '           Beveled button
                .Shape.AutoShapeType = msoShapeActionButtonCustom    
                .Shape.TextFrame.Characters.Font.Name = "Tahoma"
                .Shape.TextFrame.Characters.Font.Size = 10
                .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.Fill.ForeColor.RGB = RGB(58, 82, 184)
                .Shape.Fill.OneColorGradient msoGradientDiagonalUp, 1, 0.23
            End With
        Next Cmt

    '   Return the following activity on for future use.
        With Application
            .StatusBar = False
            .EnableEvents = True
            .DisplayAlerts = True
            .ScreenUpdating = True
        End With
    End Sub