Ndtyjky

I'm having some trouble with a macro I've been working on. It's used to delete blanks (over a million blank rows) when another separate macro is run. If I get this one working, I would like to merge the two macros together.

Here is the macro:

Sub Test()

DeleteBlankTableRows ActiveSheet.ListObjects(1)

End Sub

Sub DeleteBlankTableRows(ByVal tbl As ListObject)

Dim rng As Range

Set rng = tbl.DataBodyRange ' Get table data rows range.

Dim DirArray As Variant

DirArray = rng.Value2       ' Save table values to array.



' LOOP THROUGH ARRAY OF TABLE VALUES

Dim rowTMP As Long

Dim colTMP As Long

Dim combinedTMP As String

Dim rangeToDelete As Range



'  Loop through rows.

For rowTMP = LBound(DirArray) To UBound(DirArray)

    combinedTMP = vbNullString  ' Clear temp variable.



    ' Loop through each cell in the row and get all values combined.

    For colTMP = 1 To tbl.DataBodyRange.Columns.Count

        combinedTMP = combinedTMP & DirArray(rowTMP, colTMP)

    Next colTMP



    ' Check if row is blank.

    If combinedTMP = vbNullString Then

        ' Row is blank.  Add this blank row to the range-to-delete.

        If rangeToDelete Is Nothing Then

            Set rangeToDelete = tbl.ListRows(rowTMP).Range

        Else

            Set rangeToDelete = Union(rangeToDelete, tbl.ListRows(rowTMP).Range)

        End If

    End If

Next rowTMP



' DELETE BLANK TABLE ROWS (if any)

If Not rangeToDelete Is Nothing Then rangeToDelete.Delete

End Sub

First time it is run, it loads and acts like it's going to work. Less than a minute after loading...nothing happens (at least, visually). I run it again and it loads quickly; this time, the blank rows are visually gone.

A similar idea using an explicit parent sheet reference and Index and Max to determine if a row is blank.

Option Explicit

Public Sub DeleteRowsIfBlank()

    Dim ws As Worksheet, table As ListObject, arr(), i As Long, counter As Long, unionRng As Range

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Set table = ws.ListObjects(1)

    arr = table.DataBodyRange.Value

    counter = table.DataBodyRange.Cells(1, 1).Row

    For i = LBound(arr, 1) To UBound(arr, 1)

        If Application.Max(Application.Index(arr, i, 0)) = 0 Then

            If Not unionRng Is Nothing Then

                Set unionRng = Union(unionRng, table.Range.Rows(counter))

            Else

                Set unionRng = table.Range.Rows(counter)

            End If

        End If

        counter = counter + 1

    Next

    If Not unionRng Is Nothing Then unionRng.Delete

End Sub