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

SGMacro

New Member
Joined
Jul 11, 2015
Messages
16
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:

Code:
Sub DeleteZeroValueRows()
Code:
[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?
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

RickXL

MrExcel MVP
Joined
Sep 9, 2013
Messages
4,328
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).

Code:
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

New Member
Joined
Jul 11, 2015
Messages
16
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.

Code:
[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]
 

Watch MrExcel Video

Forum statistics

Threads
1,129,580
Messages
5,637,211
Members
416,961
Latest member
sigrid6940

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top