Deleting Preceding Blank Columns and Rows - excel

Question

I am trying to write a VBA code to cycle through each sheet in the active workbook and delete all blank columns and rows leading up to the first cell with data. For example, if the first cell with data is D5, columns A-C and Rows 1-4 would be deleted leaving the data starting in A1. I have the code below which works for the active sheet but I can't figure out how to get it to loop through the other sheets.
Sub DeleteRowsColumns()
' This will delete all Blank Columns and Rows before any data
Dim ColCounter As Long
Dim RowCounter As Long
Dim SafeCount As Integer
Dim ws As Worksheet
SafeCount = 0
' Check Column A is empty if Yes then Delete till A is populated
For Each ws In ActiveWorkbook.Worksheets
Do While ColCounter = 0
SafeCount = SafeCount + 1
ColCounter = Application.CountA(Columns(1).EntireColumn)
If ColCounter = 0 Then
Columns(1).EntireColumn.Delete
End If
If SafeCount = 50 Then
Exit Do
End If
Loop
Next ws
' Check Row 1 is empty if Yes then Delete till 1 is populated
For Each ws In ActiveWorkbook.Worksheets
SafeCount = 0
Do While RowCounter = 0
SafeCount = SafeCount + 1
RowCounter = Application.CountA(Rows(1).EntireRow)
If RowCounter = 0 Then
Rows(1).EntireRow.Delete
End If
If SafeCount = 50 Then
Exit Do
End If
'Loop
Next ws
MsgBox "Removed Preceding Blank Rows and Columns"
End Sub

Answer 1

Within each loop you need to specify which worksheet you are performing the operations on. Just looping through doesn't solve the problem. For instance:
ColCounter = Application.CountA(ws.Columns(1).EntireColumn)
If ColCounter = 0 Then
ws.Columns(1).EntireColumn.Delete
This ensures you are working in the correct worksheet.
Add it to a loop.
For X = 1 To 50
For i = 1 To 50
ColCounter = Application.CountA(ws.Columns(i).EntireColumn)
If ColCounter = 0 Then
ws.Columns(i).EntireColumn.Delete
End If
rowCounter = Application.CountA(ws.Rows(i).EntireRow)
If rowCounter = 0 Then
ws.Rows(i).EntireRow.Delete
End If
Next i
Next X

Answer 2

You could avoid any looping by first finding where the content starts (by row and then by column)
Sub RemoveEmpties()
Dim f As Range, f2 As Range, ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
'first occupied cell on sheet (by row)
Set f = ws.Cells.Find(What:="*", After:=ws.Cells(ws.Rows.Count, ws.Columns.Count), _
LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not f Is Nothing Then
'have content, so find first-occupied column
Set f2 = ws.Cells.Find(What:="*", After:=ws.Cells(ws.Rows.Count, ws.Columns.Count), _
LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
'remove rows/columns as required
If f.Row > 1 Then ws.Cells(1, 1).Resize(f.Row - 1).EntireRow.Delete
If f2.Column > 1 Then ws.Cells(1, 1).Resize(, f2.Column - 1).EntireColumn.Delete
End If
Next ws
End Sub
Alternatively (again only max of two deletes):
Sub RemoveEmpties2()
Dim ws As Worksheet, r As Long, c As Long
For Each ws In ActiveWorkbook.Worksheets
'first make sure there's some content on the sheet...
If Application.CountA(ws.Cells) > 0 Then
r = 1: c = 1
Do While Application.CountA(ws.Rows(r)) = 0
r = r + 1
Loop
If r > 1 Then ws.Rows(1).Resize(r - 1).Delete
Do While Application.CountA(ws.Columns(c)) = 0
c = c + 1
Loop
If c > 1 Then ws.Columns(1).Resize(, c - 1).Delete
End If
Next ws
End Sub

Answer 3

Using the Find Method
The Flow
In the procedure delFirstBlank the workbook is defined. A worksheet variable is declared. In the following For Each Next loop, for each worksheet in the workbook, the procedure deleteFirstBlank is called. When the loop exits, by a message box, the user is informed that the code has finished.
In the deleteFirstBlank procedure, the result of the function getFirstRow is written to a variable. The variable is then tested if it is equal to 0 i.e. the worksheet is blank. If so, then the procedure is exited. If not, the variable is tested if it is greater than 1 i.e. if at least the first row is empty. If so, the rows from the first row to the row defined by the variable decreased by one are deleted. Then the result of the function getFirstRow is written to a variable which is tested if it is greater than 1 i.e. if at least the first column is empty. If so, the columns from the first column to the column defined by the variable decreased by one are deleted.
In the getFirstRow procedure (function) a range variable is declared. Using the Find method, searching by rows, the first found non-blank cell (range) in the supplied worksheet, is assigned to the range variable. If the result of the Find method was a cell range, its row is written as the result of the function. If not, 0 is written as the result i.e. the worksheet is blank.
In the getFirstColumn procedure (function) a range variable is declared. Using the Find method, searching by columns, the first found non-blank cell (range) in the supplied worksheet, is assigned to the range variable. If the result of the Find method was a cell range, its column is written as the result of the function. If not, 0 is written as the result i.e. the worksheet is blank (the latter will never happen, because the worksheet was already tested if it is blank in the 'getFirstRow' procedure).
The Code
Option Explicit
Sub delFirstBlank()
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim ws As Worksheet
For Each ws In wb.Worksheets
deleteFirstBlank ws
Next ws
MsgBox "Removed first blank rows and columns.", vbInformation, "Success"
End Sub
Sub deleteFirstBlank(Sheet As Worksheet)
Dim Current As Long
Current = getFirstRow(Sheet)
If Current = 0 Then GoTo ProcExit ' Blank sheet.
If Current > 1 Then
Sheet.Range(Sheet.Rows(1), Sheet.Rows(CLng(Current) - 1)).Delete
End If
Current = getFirstColumn(Sheet)
If Current > 1 Then
Sheet.Range(Sheet.Columns(1), Sheet.Columns(CLng(Current) - 1)).Delete
End If
ProcExit:
End Sub
Function getFirstRow(Sheet As Worksheet) As Long
Dim rng As Range
Set rng = Sheet.Cells.Find(What:="*", _
After:=Sheet.Cells(Sheet.Rows.Count, _
Sheet.Columns.Count), _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows)
If Not rng Is Nothing Then
getFirstRow = rng.Row
Else
getFirstRow = 0 ' Blank Sheet
End If
End Function
Function getFirstColumn(Sheet As Worksheet) As Long
Dim rng As Range
Set rng = Sheet.Cells.Find(What:="*", _
After:=Sheet.Cells(Sheet.Rows.Count, _
Sheet.Columns.Count), _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns)
If Not rng Is Nothing Then
getFirstColumn = rng.Column
Else
getFirstColumn = 0 ' Blank Sheet
End If
End Function