Looping across all tabs and deleting empty rows

[Guinaba]

Hi guys,

I have the following code to loop across all tabs and delete all rows after the last row with data. I am using an user form to show which tab is being deleted. However, it doesnt seem to be working.

Do I need to active each of the sheets when deleting the rows? If yes, this part is missing in my code.

Private Sub UserForm_Activate()

'Variable Declarations
Dim i As Integer
Set mainbook = ThisWorkbook
Dim ws As Worksheet
'Get the sheet name
Dim SheetName As String
Dim SheetIndex As Integer
Dim TotalSheets As Integer
Dim pctCompl As Single

'Turning off screen updating (to reduce screen flicker) and suppressing alerts (if encountered.)
Application.ScreenUpdating = False
Application.DisplayAlerts = False

TotalSheets = ThisWorkbook.Sheets.Count
        
For Each ws In ActiveWorkbook.Worksheets
   SheetName = ws.Name
   SheetIndex = ws.Index
   Sheets(SheetIndex).Range("A1").End(xlDown).Offset(1).Resize(ActiveSheet.UsedRange.Rows.Count).EntireRow.delete
   Call progress(pctCompl, SheetName)
   pctCompl = WorksheetFunction.Round((SheetIndex / TotalSheets) * 100, 0)
 Next
   
Unload UserForm1
MsgBox "Empty Roles Deleted", vbInformation
    
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Sub progress(pctCompl As Single, SheetName As String)

UserForm1.Text = pctCompl & "% Completed"
UserForm1.LabelSheetName = "Tab= " & SheetName
UserForm1.Bar.Width = pctCompl * 2

DoEvents
End Sub

 

[jolivanes]

Do you mind me asking why you want to delete the same amount of empty rows as you have as a Used Range?
"xlDown" can be dangerous if you have empty cells in Column A in the Used Range.
Is there a possibility that some columns might have data below the last used cell of column A?

 

[Guinaba]

Do you mind me asking why you want to delete the same amount of empty rows as you have as a Used Range?
"xlDown" can be dangerous if you have empty cells in Column A in the Used Range.
Is there a possibility that some columns might have data below the last used cell of column A?

Hi @jolivanes, regardless of the reason to delete the empty rows, there is no data below the last used cell of col. A

 

[jolivanes]

Sub Maybe_So()
Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
        sh.Range("A1").End(xlDown).Offset(1).Resize(ActiveSheet.UsedRange.Rows.Count).EntireRow.Delete
    Next sh
End Sub

 

[Guinaba]

Sub Maybe_So()
Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
        sh.Range("A1").End(xlDown).Offset(1).Resize(ActiveSheet.UsedRange.Rows.Count).EntireRow.Delete
    Next sh
End Sub

Thanks @jolivanes, I'll do another test this Mon and get back to you.

 

[Guinaba]

Thanks @jolivanes, I'll do another test this Mon and get back to you.

@jolivanes, the code you sent me, it is the same as mine?

 

[Alex Blakenburg]

Try replacing Activesheet with "ws" as below.

ws.Range("A1").End(xlDown).Offset(1).Resize(ws.UsedRange.Rows.Count).EntireRow.Delete