Delete Blank Rows With Formulas. VBA

[LeeEad]

Hi,

I am currently creating an excel quoting template. Sometimes the vlookups won't return a value and if this happens I would like the row to be deleted to tidy things up. I only want this to apply to a certain section of my workbook (A81:L131). The vlookups are in columns C,E and L.

I have came across the below which works but it does it for the whole worksheet and not A81:H131

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

Appreciate any help.

Thanks

Lee

 

[Max1616]

I added an upper bound and lower bound to you code, which will only fire when i is between those row numbers. Feel free to edit those numbers when needed, or replace with dynamic code to calculate the range.

Option Explicit
   
Sub DelEmptyBorders()
Dim rngData    As Range
Dim rngTemp    As Range
Dim i          As Long
Dim LowerBound As Integer
Dim UpperBound As Integer
    
    LowerBound = 81
    UpperBound = 131
    
    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 And i <= UpperBound And i >= LowerBound 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 hope this helps!

 

[Fuji]

Just for the range A81:L131.

Sub DelEmptyBorders()
    Dim x
    x = Filter([transpose(if(countblank(offset(A81:L131,row(1:51)-1,,1,12))=12,"A"&row(A81:L131)))], False, 0)
    If UBound(x) > -1 Then Range(Join(x, ",")).EntireRow.Delete
End Sub