I would tremendously appreciate help in coding a deletion of all blank rows
from all worksheets in all files within a certain directory.

I have code that merges multiple documents but I found that any blank row
will stop the merge at that point. The number of documents makes manual
deletion too costly in terms of time and effort.

I found the following code elsewhere for deleting blanks from a single
worksheet...can anyone tell me how to generalize this to multiple sheets &
multiple documents? Below I will include the code I have both for deleting
empty rows from a single sheet and for combining multiple sheets/documents.
I'll separate with a big ************************. Thanks!!!!

Sub DeleteEmptyRows()

Dim LastRow As Long, r As Long

LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

Application.ScreenUpdating = True

End Sub
************************************************** ************************************************** ************************************************** ******************************
Sub ConsolidateWithLabels()
' Will consolidate Mulitple Sheets
' from Multiple Files onto one sheet
' Never tested with files that would
' give more than one sheets as end result
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) < ThisWorkbook.FullName Then
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(1).Range("C65536").End(xlUp).O ffset(1, 0)
With Basebook.Worksheets(1)
.Range(.Range("A65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -2)).Value = _
myBook.Name
.Range(.Range("B65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -1)).Value = _
mySheet.Name
End With
Next mySheet
myBook.Close
End If
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

Basebook.SaveAs Application.GetSaveAsFilename

End Sub

The code below is untested. Make a new folder and put a copy of a few of
your workbooks to be cleaned up into it along with a workbook with this code
in it. Open the workbook with this code in it and run the
MassFileAndSheetCleanup macro. Examine the other workbooks after it
completes to make sure it worked properly. If it looks good, copy the rest
of the workbooks to be cleaned up into that same folder and run it again.
This way you have cleaned up copies and still have the originals if something
goes wrong. I've not altered your other code at all, I just call the
DeleteEmptyRows routine from within this code, although I show that code here
also. This obviously does nothing to consolodate workbooks - you already
have that other routine to do that with after getting things cleaned up.
Hope this helps.

Sub MassFileAndSheetCleanup()
'put the file containing this code
'in the same folder with all other .xls
'files to be cleaned up and then
'open this workbook and run this macro
Dim anyFile As String
Dim basePath As String
Dim anySheet As Worksheet
Dim anyWB As Workbook

basePath = Left(ThisWorkbook.FullName, _
InStrRev(ThisWorkbook.FullName, "\"))
anyFile = Dir$(basePath & "*.xls")
Do While anyFile < ""
If anyFile < ThisWorkbook.Name Then
Workbooks.Open basePath & anyFile
'the opened workbook becomes the active workbook
'now go through the sheets in that workbook
Application.ScreenUpdating = False
For Each anySheet In ActiveWorkbook.Worksheets
If anySheet.Visible = xlSheetVisible Then
' so your routine can work w/o change
anySheet.Select
DeleteEmptyRows ' call your routine
Application.ScreenUpdating = False
End If
Next
ActiveWorkbook.Close True ' close and save changes
'this workbook is again the active workbook
End If
'get next filename
anyFile = Dir$()
Loop
Application.ScreenUpdating = True
MsgBox "Cleanup is complete."
End Sub

Sub DeleteEmptyRows()

Dim LastRow As Long, r As Long

LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

Application.ScreenUpdating = True

End Sub


"BenS" wrote:

I would tremendously appreciate help in coding a deletion of all blank rows
from all worksheets in all files within a certain directory.

I have code that merges multiple documents but I found that any blank row
will stop the merge at that point. The number of documents makes manual
deletion too costly in terms of time and effort.

I found the following code elsewhere for deleting blanks from a single
worksheet...can anyone tell me how to generalize this to multiple sheets &
multiple documents? Below I will include the code I have both for deleting
empty rows from a single sheet and for combining multiple sheets/documents.
I'll separate with a big ************************. Thanks!!!!

Sub DeleteEmptyRows()

Dim LastRow As Long, r As Long

LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

Application.ScreenUpdating = True

End Sub
************************************************** ************************************************** ************************************************** ******************************
Sub ConsolidateWithLabels()
' Will consolidate Mulitple Sheets
' from Multiple Files onto one sheet
' Never tested with files that would
' give more than one sheets as end result
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) < ThisWorkbook.FullName Then
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(1).Range("C65536").End(xlUp).O ffset(1, 0)
With Basebook.Worksheets(1)
.Range(.Range("A65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -2)).Value = _
myBook.Name
.Range(.Range("B65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -1)).Value = _
mySheet.Name
End With
Next mySheet
myBook.Close
End If
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

Basebook.SaveAs Application.GetSaveAsFilename

End Sub

Thank you for your code J. I think it worked and I'm thrilled about that.
There was one strange side effect that I wonder if you know why it happens.
It increases the size of my files (about 60 of them) from about 1mb to
anywhere from 13 to 26MB. So they are not really portable for me anymore. I
see some formatted cells (colors) now going down the entire document which
may be the cause of this.
I'm thrilled though, at what it did do and am very grateful for your
assistance.

-BenS

"JLatham" wrote:

The code below is untested. Make a new folder and put a copy of a few of
your workbooks to be cleaned up into it along with a workbook with this code
in it. Open the workbook with this code in it and run the
MassFileAndSheetCleanup macro. Examine the other workbooks after it
completes to make sure it worked properly. If it looks good, copy the rest
of the workbooks to be cleaned up into that same folder and run it again.
This way you have cleaned up copies and still have the originals if something
goes wrong. I've not altered your other code at all, I just call the
DeleteEmptyRows routine from within this code, although I show that code here
also. This obviously does nothing to consolodate workbooks - you already
have that other routine to do that with after getting things cleaned up.
Hope this helps.

Sub MassFileAndSheetCleanup()
'put the file containing this code
'in the same folder with all other .xls
'files to be cleaned up and then
'open this workbook and run this macro
Dim anyFile As String
Dim basePath As String
Dim anySheet As Worksheet
Dim anyWB As Workbook

basePath = Left(ThisWorkbook.FullName, _
InStrRev(ThisWorkbook.FullName, "\"))
anyFile = Dir$(basePath & "*.xls")
Do While anyFile < ""
If anyFile < ThisWorkbook.Name Then
Workbooks.Open basePath & anyFile
'the opened workbook becomes the active workbook
'now go through the sheets in that workbook
Application.ScreenUpdating = False
For Each anySheet In ActiveWorkbook.Worksheets
If anySheet.Visible = xlSheetVisible Then
' so your routine can work w/o change
anySheet.Select
DeleteEmptyRows ' call your routine
Application.ScreenUpdating = False
End If
Next
ActiveWorkbook.Close True ' close and save changes
'this workbook is again the active workbook
End If
'get next filename
anyFile = Dir$()
Loop
Application.ScreenUpdating = True
MsgBox "Cleanup is complete."
End Sub

Sub DeleteEmptyRows()

Dim LastRow As Long, r As Long

LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

Application.ScreenUpdating = True

End Sub


"BenS" wrote:

I would tremendously appreciate help in coding a deletion of all blank rows
from all worksheets in all files within a certain directory.

I have code that merges multiple documents but I found that any blank row
will stop the merge at that point. The number of documents makes manual
deletion too costly in terms of time and effort.

I found the following code elsewhere for deleting blanks from a single
worksheet...can anyone tell me how to generalize this to multiple sheets &
multiple documents? Below I will include the code I have both for deleting
empty rows from a single sheet and for combining multiple sheets/documents.
I'll separate with a big ************************. Thanks!!!!

Sub DeleteEmptyRows()

Dim LastRow As Long, r As Long

LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

Application.ScreenUpdating = True

End Sub
************************************************** ************************************************** ************************************************** ******************************
Sub ConsolidateWithLabels()
' Will consolidate Mulitple Sheets
' from Multiple Files onto one sheet
' Never tested with files that would
' give more than one sheets as end result
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) < ThisWorkbook.FullName Then
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(1).Range("C65536").End(xlUp).O ffset(1, 0)
With Basebook.Worksheets(1)
.Range(.Range("A65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -2)).Value = _
myBook.Name
.Range(.Range("B65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -1)).Value = _
mySheet.Name
End With
Next mySheet
myBook.Close
End If
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

Basebook.SaveAs Application.GetSaveAsFilename

End Sub

I know of no reason at all that your workbooks should be getting larger or
that they should suddenly have colored cells running all the way down the
sheet(s).

The code I wrote only does the following:
determine names of .xls files within the same folder with the workbook with
the code.
open those other .xls files, one at a time,
"flip" through the visible worksheets in the workbook and makes each one
active, in turn and while it is active it calls that DeleteEmptyRows routine
to actually remove the empty rows.
after it's worked through all of the visible sheets, it closed the workbook
and moves on to look for another one.

It doesn't actually take any action in a workbook or worksheet other than to
open the workbook and activate each sheet in turn.

I would look at other routines you might be using, to see if they are (as
the DeleteEmptyRows) actually manipulating things in a way that may make the
changes you've noted.

One way to test whether the code I wrote is doing this or not, once again
move all of the original files into a separate test folder and run the code,
but either:
1) leave the DeleteEmptyRows ' call your routine
statement out of the code completely, or
put an
Exit Sub
statement as the very first statement in the Sub DeleteEmptyRows() code so
that it actually does nothing.

Note the file sizes before running the code and after it has completed. Let
me know how things turn out.

JLatham

"BenS" wrote:

Thank you for your code J. I think it worked and I'm thrilled about that.
There was one strange side effect that I wonder if you know why it happens.
It increases the size of my files (about 60 of them) from about 1mb to
anywhere from 13 to 26MB. So they are not really portable for me anymore. I
see some formatted cells (colors) now going down the entire document which
may be the cause of this.
I'm thrilled though, at what it did do and am very grateful for your
assistance.

-BenS

"JLatham" wrote:

The code below is untested. Make a new folder and put a copy of a few of
your workbooks to be cleaned up into it along with a workbook with this code
in it. Open the workbook with this code in it and run the
MassFileAndSheetCleanup macro. Examine the other workbooks after it
completes to make sure it worked properly. If it looks good, copy the rest
of the workbooks to be cleaned up into that same folder and run it again.
This way you have cleaned up copies and still have the originals if something
goes wrong. I've not altered your other code at all, I just call the
DeleteEmptyRows routine from within this code, although I show that code here
also. This obviously does nothing to consolodate workbooks - you already
have that other routine to do that with after getting things cleaned up.
Hope this helps.

Sub MassFileAndSheetCleanup()
'put the file containing this code
'in the same folder with all other .xls
'files to be cleaned up and then
'open this workbook and run this macro
Dim anyFile As String
Dim basePath As String
Dim anySheet As Worksheet
Dim anyWB As Workbook

basePath = Left(ThisWorkbook.FullName, _
InStrRev(ThisWorkbook.FullName, "\"))
anyFile = Dir$(basePath & "*.xls")
Do While anyFile < ""
If anyFile < ThisWorkbook.Name Then
Workbooks.Open basePath & anyFile
'the opened workbook becomes the active workbook
'now go through the sheets in that workbook
Application.ScreenUpdating = False
For Each anySheet In ActiveWorkbook.Worksheets
If anySheet.Visible = xlSheetVisible Then
' so your routine can work w/o change
anySheet.Select
DeleteEmptyRows ' call your routine
Application.ScreenUpdating = False
End If
Next
ActiveWorkbook.Close True ' close and save changes
'this workbook is again the active workbook
End If
'get next filename
anyFile = Dir$()
Loop
Application.ScreenUpdating = True
MsgBox "Cleanup is complete."
End Sub

Sub DeleteEmptyRows()

Dim LastRow As Long, r As Long

LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

Application.ScreenUpdating = True

End Sub


"BenS" wrote:

I would tremendously appreciate help in coding a deletion of all blank rows
from all worksheets in all files within a certain directory.

I have code that merges multiple documents but I found that any blank row
will stop the merge at that point. The number of documents makes manual
deletion too costly in terms of time and effort.

I found the following code elsewhere for deleting blanks from a single
worksheet...can anyone tell me how to generalize this to multiple sheets &
multiple documents? Below I will include the code I have both for deleting
empty rows from a single sheet and for combining multiple sheets/documents.
I'll separate with a big ************************. Thanks!!!!

Sub DeleteEmptyRows()

Dim LastRow As Long, r As Long

LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

Application.ScreenUpdating = True

End Sub
************************************************** ************************************************** ************************************************** ******************************
Sub ConsolidateWithLabels()
' Will consolidate Mulitple Sheets
' from Multiple Files onto one sheet
' Never tested with files that would
' give more than one sheets as end result
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) < ThisWorkbook.FullName Then
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(1).Range("C65536").End(xlUp).O ffset(1, 0)
With Basebook.Worksheets(1)
.Range(.Range("A65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -2)).Value = _
myBook.Name
.Range(.Range("B65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -1)).Value = _
mySheet.Name
End With
Next mySheet
myBook.Close
End If
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

Basebook.SaveAs Application.GetSaveAsFilename

End Sub