need to remove empty rows from Excel table and then resize the table - using VBA

Question

I wrote a macro (mostly by recording it) that copies data from a section on one sheet then calculates the end of my table on another sheet and pastes (paste special, being that the data I am pasting is a formula and I need to paste the values) the data to the end of my table, which on its own increases the size of my table. That works.

My problem is that I am not sure how much of my original range of data (that I am copying) will actually have values in it (there is a formula that is either giving it a value or ""), so I take a large range, just in case

So.... after I pasted it I would like to go through my table and remove any rows that were added that only had empty strings ("") and no values, and then resize the table so it is only as large as the rows that have data. These rows can be in the middle or at the end of my pasted data. I need help on the VBA code to do that.

I may also need to clear the formatting that the table automatically added to those additional rows here is the code I have until now

Range("O7:R30").Select    
Selection.Copy
Sheets("deposits").Select
Dim lastRow As Long
lastRow = ActiveSheet.ListObjects("deposits").Range.Rows.Count
Range("A" & lastRow).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

I tried Range("deposits[amount]").SpecialCells(xlCellTypeBlanks).EntireRow.Delete and it threw and error that no data found. It seems even though the rows appear blank apparently they don't trigger xlCellTypeBlanks. P.s. it didn't work when I selected the table (ctl-a) and then used F5 using special->blanks. It also returned no data. even though the cells are clearly blank — zfeld, May 15 '18 at 04:22
*that only had empty strings ("")* The cell having formula returning empty string is ***not*** empty. — JohnyL, May 15 '18 at 07:46
Yeah, I get that. Is there a way to figure out there is "something" in a cell when it is ("")? or is there a better way to tell an IF formula to leave a cell really empty — zfeld, May 15 '18 at 20:51
You can use `COUNTA` function which would return the number of cells which are not empty, *even cells which return empty string like `=""`* — JohnyL, May 15 '18 at 20:57

score 1 · Answer 1 · answered May 15 '18 at 06:19

Probably best to only place data into the table if its valid, rather than clean up after the paste.

Something like this

Sub Demo()
    Dim rDest As Range
    Dim lo As ListObject
    Dim wsSrc As Worksheet
    Dim rSrc As Variant
    Dim i As Long
    Dim rng As Range

    'there are better ways to get a reference to the source data, but thats not the Q here
    Set wsSrc = ActiveSheet
    Set rSrc = wsSrc.Range("O7:R30")

    ' destination sheet
    With Sheets("deposits")
        'get reference to table
        Set lo = .ListObjects("deposits")

        'Get reference to first row after the table
        Set rDest = lo.DataBodyRange.Rows(lo.DataBodyRange.Rows.Count + 1)

        i = 0
        'loop thru source data rows
        For Each rng In rSrc.Rows
            'if a row has data
            If Application.WorksheetFunction.CountA(rng) > 0 Then
                'copy values into table
                rDest.Offset(i).Value = rng.Value
                i = i + 1
            End If
        Next
    End With
End Sub

It didn't work. a. It didn't add it to the table it just was added to the bottom under the table but did not get the table formatting, etc. whatever normally you get by adding a new row after a table b. it didn't remove empty lines that were in between lines with data — zfeld, May 15 '18 at 20:39
I am guessing that CountA may be returning greater than 0, because there is a copied formula in the rows (even the "blank" rows) — zfeld, May 15 '18 at 20:56

score 1 · Answer 2 · answered May 15 '18 at 20:49

This code worked, not elegant, but it worked

Sub copyToDeposits()

Dim theSheet As String
theSheet = ActiveSheet.Name
Application.ScreenUpdating = False
Range("O7:R30").Select
Selection.Copy
Sheets("deposits").Select
Dim lastRow As Long
lastRow = ActiveSheet.ListObjects("deposits").Range.Rows.Count
Range("A" & lastRow).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Dim lo As ListObject
Dim lRow As ListRow
Dim rng As Range
Dim delRows As Collection

Set lo = ActiveSheet.ListObjects("deposits") 'change to your table name
On Error Resume Next
For Each lRow In lo.ListRows
    Set rng = Nothing
    Set rng = lRow.Range.Cells(1, 2)
    If Not rng Is Nothing Then
        If rng = "" Then
            If delRows Is Nothing Then
                Set delRows = New Collection
                delRows.Add lRow
            Else
                delRows.Add lRow, Before:=1
            End If
        End If
    End If
Next
On Error GoTo 0

If Not delRows Is Nothing Then
    For Each lRow In delRows
        lRow.Delete
    Next
End If
Sheets(theSheet).Select
Application.ScreenUpdating = True

End Sub

need to remove empty rows from Excel table and then resize the table - using VBA

2 Answers2