Delete all charts and empty rows from all sheets; won't change sheets

Hello,

I am working on a macro that would:

1. delete all charts from the sheet
2. select rows from row 1 to last row that has data; this range will have some full and some empty rows
3. delete empty rows from this range
4. move onto the next Sheet and repeat
5. do this for all sheets in a Workbook

My Macro seems to be working more or less fine EXCEPT it would not do the "select rows, delete empty ones" on other sheets but the first one (one in focus). Any ideas what might be wrong?

Thanks!

Sub Delete_Charts_Rows_all_Sheets()
Dim Ws As Worksheet, chtObj As ChartObject, i As Long, Lastrow As Long 
       
        
        With Application            
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
           

                For Each Ws In ThisWorkbook.Worksheets
                           
                        For Each chtObj In Ws.ChartObjects
                              chtObj.Delete
                        Next                                     
                                       
 
                          Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
                          Range("1:" & Lastrow).Select
                                   
                           
                        For i = Selection.Rows.Count To 1 Step -1
                              If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
                                  Selection.Rows(i).EntireRow.Delete
                              End If           
                        Next
               
                Next Ws
               
               
       .Calculation = xlCalculationAutomatic
       .ScreenUpdating = True        
       End With

End Su

b

Try changing

Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
                          Range("1:" & Lastrow).Select
                                    
                        For i = Selection.Rows.Count To 1 Step -1
                              If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
                                  Selection.Rows(i).EntireRow.Delete

To

Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For i = Lastrow To 1 Step -1
             If WorksheetFunction.CountA(Rows(i)) = 0 Then
                        Rows(i).EntireRow.Delete

Hey Alf,

thanks for your imput, much appreciated! Unfortunately - no. The charts get deleted from all sheets but rows still get deleted only on the first (actually active sheet). I tried chahging

LastRow = Active.Cells(Rows.Count, 1).End(xlUp).Row

With

LastRow = Ws.Cells(Rows.Count, 1).End(xlUp).Row

but nope. It just wont work

SOLVED!!! My god... after 2 days


'FINAL - deletes all charts AND deletes empty rows from ALL sheets in workbook

Sub Delete_Charts_and_EmtyRows()

Dim Ws As Worksheet, chtObj As ChartObject, i As Long, LastRow As Long
        With Application                                        
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
        
                    
                    For Each Ws In ThisWorkbook.Worksheets
                        Ws.Activate                             'KEY!! This seems to have solved looping through Sheets
                            
                            For Each chtObj In Ws.ChartObjects  'Finds chart objects and deletes them
                                    chtObj.Delete
                            Next
                                    
                                    
                                    LastRow = Ws.Cells(Rows.Count, 1).End(xlUp).Row     'Returns the number of last row with data, stores it in var LastRow
                            
                            
                            For i = LastRow To 1 Step -1        'Loops through the selection, deletes empty rows
                                If WorksheetFunction.CountA(Rows(i)) = 0 Then
                                    Rows(i).EntireRow.Delete
                                End If
                            Next
                            
                    
                    Next Ws
                
            .Calculation = xlCalculationAutomatic
            .ScreenUpdating = True
        End With

End Sub

You solved it!! Good!!!

Don't forget to mark your thread "Solved"

Alf

Ps

To mark your thread solved do the following:
-Go to the top of the first post
-Select Thread Tools
-Select Mark thread as Solved