VBA: Delete rows with no values.

[hamistasty]

Rick rothstein made this code to help me delete columns with no values in them:

Sub DeleteAllBlankColumns()
  Dim LastRow As Long
  LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  On Error Resume Next
  With Range("A" & (LastRow + 1) & ":CJ" & (LastRow + 1))
    .FormulaR1C1 = "=IF(COUNTBLANK(R2C:R" & LastRow & "C)=" & (LastRow - 1) & ",""X"","""")"
    .Value = .Value
    .SpecialCells(xlCellTypeConstants).EntireColumn.delete
  End With
End Sub

Was hoping to get some assistance editing it.

I want it to ALSO delete entire rows in the worksheet that do not have any values across the entire row. Currently the worksheet prints rows that have borders but no values. This would eliminate that problem.

But if there is a value in any cell of the entire row it keeps that row.

 

[Domenic]

To delete empty rows, try...

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] DeleteEmptyRows()

    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] Cnt [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] r [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    LastRow = Cells.Find(what:="*", _
                                after:=Range("A1"), _
                                LookIn:=xlFormulas, _
                                lookat:=xlPart, _
                                searchorder:=xlByRows, _
                                searchdirection:=xlPrevious, _
                                MatchCase:=False).Row
                                
    [color=darkblue]For[/color] r = LastRow [color=darkblue]To[/color] 1 [color=darkblue]Step[/color] -1
        [color=darkblue]If[/color] WorksheetFunction.CountA(Rows(r)) = 0 [color=darkblue]Then[/color]
            Rows(r).Delete
            Cnt = Cnt + 1
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] r
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
                                
    MsgBox Cnt & " rows were deleted.", vbInformation
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

 

[hamistasty]

It isn't deleting rows that have no values but have a border and thus are included in page break preview.

 

[Domenic]

I've got to get going for now, so if no one else comes forward to help I'll look at this again sometime tomorrow.

 

[Domenic]

Try replacing...

LastRow = Cells.Find(what:="*", _
                                after:=Range("A1"), _
                                LookIn:=xlFormulas, _
                                lookat:=xlPart, _
                                searchorder:=xlByRows, _
                                searchdirection:=xlPrevious, _
                                MatchCase:=False).Row

with

[font=Verdana]    [color=darkblue]With[/color] ActiveSheet.UsedRange
    
        LastRow = .Rows.Count + .Rows(1).Row - 1
        
    [color=darkblue]End[/color] [color=darkblue]With[/color]
                                [/font]

 

[hamistasty]

Hmm the code just never stops looping?? I have to escape to end the loading.

Thanks for all the help so far.

This is the current code:

Sub DeleteEmptyRows()
    Dim LastRow As Long
    Dim Cnt As Long
    Dim r As Long
    
    With ActiveSheet.UsedRange
    LastRow = .Rows.Count + .Rows(1).Row - 1
    End With
                                                       
    For r = LastRow To 1 Step -1
        If WorksheetFunction.CountA(Rows(r)) = 0 Then
            Rows(r).delete
            Cnt = Cnt + 1
        End If
    Next r
    
End Sub

There is a screenloading etc. false in the sub I called this from

 

[GTO]

Except for the worksheet function, this seems close to what has already been tried, so maybe, maybe not...

Just to test, in a junk copy of your wb, ensure the sheet of interest is active and run from a Standard Module:

Option Explicit
    
Sub DelEmptyBorders()
Dim rngData As Range
Dim rngTemp As Range
Dim i       As Long
     
    Set rngData = RangeFound(Cells)
    If Not rngData Is Nothing Then
        Set rngData = Range(Range("A1"), Cells(rngData.Row, RangeFound(Cells, , , , , xlByColumns).Column))
        
        Rows(rngData.Rows.Count + 1 & ":" & Rows.Count).Delete xlShiftUp
        
        For i = rngData.Rows.Count To 1 Step -1
            Set rngTemp = RangeFound(rngData.Rows(i), , , , , xlByColumns)
            If rngTemp Is Nothing Then
                rngData.Rows(i).EntireRow.Delete xlShiftUp
            Else
                Set rngTemp = Nothing
            End If
        Next
    End If
End Sub
    
Function RangeFound(rng As Range, _
                    Optional ByVal What As Variant = "*", _
                    Optional After As Range, _
                    Optional LookInValsOrFormulasOrComments As XlFindLookIn = xlValues, _
                    Optional LookAtWholeOrPart As XlLookAt = xlPart, _
                    Optional SearchByRowsOrColumns As XlSearchOrder = xlByRows, _
                    Optional SearchNextOrPrevious As XlSearchDirection = xlPrevious, _
                    Optional MatchCase As Boolean = False) As Range
    
    If After Is Nothing Then Set After = rng.Cells(1)
    
    Set RangeFound = rng.Find(What:=What, _
                              After:=After, _
                              LookIn:=LookInValsOrFormulasOrComments, _
                              LookAt:=LookAtWholeOrPart, _
                              SearchOrder:=SearchByRowsOrColumns, _
                              SearchDirection:=SearchNextOrPrevious, _
                              MatchCase:=MatchCase)
End Function

I would try any of the code on its own first, if calling from another procedure currently.

 

[hamistasty]

Thanks that worked great.

 

[GTO]

Glad that worked Just as a comment, Domenic's first seemed to work fine for me.