Not Enough Memory - Remove Rows Containing Blank Values in Specified Column From All Open Workbooks

[SGMacro]

I have been using a macro to pull together worksheets from all open workbooks into a single sheet discussed here:

Combining All Open Workbooks into Single Worksheet

I then have another macro I have been using that removes a row if there is no value within a specified column shown here:

Sub DeleteZeroValueRows()

[COLOR=#232323][FONT=Verdana]Dim nMaxRow As Long, nrow As Long[/FONT][/COLOR]

[COLOR=#232323][FONT=Verdana]'Application.ScreenUpdating = False Stops Screen Flicker When Running VBA Code[/FONT][/COLOR]
[COLOR=#232323][FONT=Verdana]Application.ScreenUpdating = False[/FONT][/COLOR][COLOR=#232323][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#232323][FONT=Verdana]nMaxRow = ActiveSheet.UsedRange.Rows.Count[/FONT][/COLOR][COLOR=#232323][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#232323][FONT=Verdana] 'Remove Rows Containing Blank Values in Specified Column [/FONT][/COLOR]
[COLOR=#232323][FONT=Verdana]For nrow = nMaxRow To 1 Step -1[/FONT][/COLOR]
[COLOR=#232323][FONT=Verdana]        If Range("N" & nrow).Value = 0 Then[/FONT][/COLOR]
[COLOR=#232323][FONT=Verdana]        Range("N" & nrow).EntireRow.Delete[/FONT][/COLOR]
[COLOR=#232323][FONT=Verdana]        End If[/FONT][/COLOR]
[COLOR=#232323][FONT=Verdana]Next nrow[/FONT][/COLOR]

[COLOR=#232323][FONT=Verdana]End Sub[/FONT][/COLOR]

The problem is when I run the Sub DeleteZeroValueRows() macro on the workbook Combining All Open Workbooks into Single Worksheet it results in a "Not Enough Memory" fault.

My initial thought is to try adapt the Sub DeleteZeroValueRows() macro to "Remove Rows Containing Blank Values in Specified Column From All Open Workbooks" but cannot figure out how to do this. I have looked at trying to use some of the code within the Combining All Open Workbooks into Single Worksheet but cannot figure it out. Can anyone help?

 

[RickXL]

Hi,

Something like this should work better.

It assumes that A1 is the start cell and it finds the last row and column.
Then it AutoFilters that range selecting null characters.
When it has found them it removes the visible lines excluding line 1 (assumed headings).

Sub delBlanks()

   Dim r As Range
   Dim lr As Long
   Dim lc As Long

   lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   lc = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
   
   Set r = Range("A1", Cells(lr, lc))

   Application.ScreenUpdating = False
   If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
   r.AutoFilter
   r.AutoFilter Field:=14, Criteria1:=""
   r.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
   ActiveSheet.AutoFilterMode = False
   Application.ScreenUpdating = True
   
End Sub

 

[SGMacro]

Thanks. I tried the above does but the debugger kept coming up with the "r.AutoFilter" as an error I could not fix.

After some tweaking I have modified the original code so it now deletes rows of target blank cells of all open workbooks, copies target sheet and pastes it into the active workbook.

Its working at 99% but for some reason some of the blank cells still remain, even though it deletes hundreds correctly. I've checked the cells and they are 100% empty so not sure why they remain. They are unprotected and can be deleted manually.

[FONT=Arial]Sub CombinedWorksheetsFromOpenWorkbook_DeleteZeroValueRows() 'Worksheets only import when named Sheet1[/FONT]
[FONT=Arial]    Dim Wkb As Workbook[/FONT]
[FONT=Arial]    Dim sWksName As String[/FONT]
[FONT=Arial]    Dim nMaxRow As Long, nrow As Long[/FONT]
[FONT=Arial]
[/FONT]
[FONT=Arial]'Application.ScreenUpdating = False Stops Screen Flicker When Running VBA Code[/FONT]
[FONT=Arial]Application.ScreenUpdating = False[/FONT]
[FONT=Arial]
[/FONT]
[FONT=Arial]    sWksName = “Sheet1”[/FONT]
[FONT=Arial]    For Each Wkb In Workbooks[/FONT]
[FONT=Arial]    [/FONT]
[FONT=Arial]    'This section deletes blank rowsbased if target empty cell is empty[/FONT]
[FONT=Arial]    nMaxRow = ActiveSheet.UsedRange.Rows.Count[/FONT]
[FONT=Arial]    For nrow = nMaxRow To 1 Step -1[/FONT]
[FONT=Arial]        If Range(“D” & nrow).Value = 0 Then[/FONT]
[FONT=Arial]        Range(“D” & nrow).EntireRow.Delete[/FONT]
[FONT=Arial]        End If[/FONT]
[FONT=Arial]Next nrow[/FONT]
[FONT=Arial]
[/FONT]
[FONT=Arial]'This section copies open workbooks sWsName and pastes into active workbook[/FONT]
[FONT=Arial]        If Wkb.Name <> ThisWorkbook.Name Then[/FONT]
[FONT=Arial]            Wkb.Worksheets(sWksName).Copy _[/FONT]
[FONT=Arial]              Before:=ThisWorkbook.Sheets(1)[/FONT]
[FONT=Arial]        End If[/FONT]
[FONT=Arial]    Next[/FONT]
[FONT=Arial]    Set Wkb = Nothing[/FONT]
[FONT=Arial]End Sub[/FONT]