Delete Entire Rows if Whole Range is Blank

[AsifShah]

Hello Friends

I have a Data in Sheet2,
My Data infomation
Row A1:D1>>> School & Date Information
Row E1:DA1 >> Class Name
Row E2:DA2 >> Book Name
Now iam coping data Sheet2 to an other sheet11 by Class Name Wise, Class name Coding work fine and Blank row Deleting Work Fine .
Problem is that my Delete Blank Rows code is to long . Can any Friend do code short and work fast,

Thanks in Advance

Private Sub cGetData_Click()
On Error Resume Next
Sheet11.Range("E:T").Clear

Dim arx, ary, fm
Sheet2.Range("A:D").Copy Sheet11.Range("A:D")

arx = Array("Nursery Class", "KG Class", "One Class", "Two Class", "Three Class", "Four Class", "Five Class", "Six Class", "Saven Class", "Eight Class", "Nine Class")
ary = Array("E:F", "G:L", "M:V", "X:AD", "AE:AP", "AQ:AZ", "BA:BJ", "BK:BS", "BT:CB", "CC:CK", "CL:DA")

    fm = Application.Match(ComboBox5.Value, arx, 0)
    If IsNumeric(fm) Then Sheet2.Range(ary(fm - 1)).Copy Sheet11.Range("E1")
'
'Delete Rows
 Dim lngLastRow As Long
    Dim lngMyRow As Long
    Dim xlnCalcMethod As XlCalculation
    
    With Application
        .ScreenUpdating = False
        xlnCalcMethod = .Calculation
        .Calculation = xlCalculationManual
    End With
    
    lngLastRow = Range("A:L").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    

    For lngMyRow = lngLastRow To 3 Step -1
        If Len(Range("E" & lngMyRow)) = 0 And Len(Range("F" & lngMyRow)) = 0 _
        And Len(Range("G" & lngMyRow)) = 0 And Len(Range("H" & lngMyRow)) = 0 _
        And Len(Range("I" & lngMyRow)) = 0 And Len(Range("J" & lngMyRow)) = 0 _
        And Len(Range("K" & lngMyRow)) = 0 And Len(Range("L" & lngMyRow)) = 0 _
        And Len(Range("M" & lngMyRow)) = 0 And Len(Range("N" & lngMyRow)) = 0 _
        And Len(Range("O" & lngMyRow)) = 0 And Len(Range("P" & lngMyRow)) = 0 _
        And Len(Range("Q" & lngMyRow)) = 0 And Len(Range("R" & lngMyRow)) = 0 _
        And Len(Range("S" & lngMyRow)) = 0 And Len(Range("T" & lngMyRow)) = 0 Then
            Rows(lngMyRow).EntireRow.Delete
        End If
    Next lngMyRow
    
    With Application
        .Calculation = xlnCalcMethod
        .ScreenUpdating = True
    End With
End Sub

 

[Joe4]

I think you should be able to delete this whole section:

    For lngMyRow = lngLastRow To 3 Step -1
        If Len(Range("E" & lngMyRow)) = 0 And Len(Range("F" & lngMyRow)) = 0 _
        And Len(Range("G" & lngMyRow)) = 0 And Len(Range("H" & lngMyRow)) = 0 _
        And Len(Range("I" & lngMyRow)) = 0 And Len(Range("J" & lngMyRow)) = 0 _
        And Len(Range("K" & lngMyRow)) = 0 And Len(Range("L" & lngMyRow)) = 0 _
        And Len(Range("M" & lngMyRow)) = 0 And Len(Range("N" & lngMyRow)) = 0 _
        And Len(Range("O" & lngMyRow)) = 0 And Len(Range("P" & lngMyRow)) = 0 _
        And Len(Range("Q" & lngMyRow)) = 0 And Len(Range("R" & lngMyRow)) = 0 _
        And Len(Range("S" & lngMyRow)) = 0 And Len(Range("T" & lngMyRow)) = 0 Then
            Rows(lngMyRow).EntireRow.Delete
        End If
    Next lngMyRow

with this:

    Dim rng As Range
    For lngMyRow = lngLastRow To 3 Step -1
        Set rng = Range("E" & lngMyRow & ":T" & lngMyRow)
        If Application.CountA(rng) = 0 Then Rows(lngMyRow).Delete
    Next lngMyRow

 

[AsifShah]

I think you should be able to delete this whole section:

    For lngMyRow = lngLastRow To 3 Step -1
        If Len(Range("E" & lngMyRow)) = 0 And Len(Range("F" & lngMyRow)) = 0 _
        And Len(Range("G" & lngMyRow)) = 0 And Len(Range("H" & lngMyRow)) = 0 _
        And Len(Range("I" & lngMyRow)) = 0 And Len(Range("J" & lngMyRow)) = 0 _
        And Len(Range("K" & lngMyRow)) = 0 And Len(Range("L" & lngMyRow)) = 0 _
        And Len(Range("M" & lngMyRow)) = 0 And Len(Range("N" & lngMyRow)) = 0 _
        And Len(Range("O" & lngMyRow)) = 0 And Len(Range("P" & lngMyRow)) = 0 _
        And Len(Range("Q" & lngMyRow)) = 0 And Len(Range("R" & lngMyRow)) = 0 _
        And Len(Range("S" & lngMyRow)) = 0 And Len(Range("T" & lngMyRow)) = 0 Then
            Rows(lngMyRow).EntireRow.Delete
        End If
    Next lngMyRow

with this:

    Dim rng As Range
    For lngMyRow = lngLastRow To 3 Step -1
        Set rng = Range("E" & lngMyRow & ":T" & lngMyRow)
        If Application.CountA(rng) = 0 Then Rows(lngMyRow).Delete
    Next lngMyRow

Joe Thanks Alot..... Code working excellent.

 

[AsifShah]

I think you should be able to delete this whole section:

    For lngMyRow = lngLastRow To 3 Step -1
        If Len(Range("E" & lngMyRow)) = 0 And Len(Range("F" & lngMyRow)) = 0 _
        And Len(Range("G" & lngMyRow)) = 0 And Len(Range("H" & lngMyRow)) = 0 _
        And Len(Range("I" & lngMyRow)) = 0 And Len(Range("J" & lngMyRow)) = 0 _
        And Len(Range("K" & lngMyRow)) = 0 And Len(Range("L" & lngMyRow)) = 0 _
        And Len(Range("M" & lngMyRow)) = 0 And Len(Range("N" & lngMyRow)) = 0 _
        And Len(Range("O" & lngMyRow)) = 0 And Len(Range("P" & lngMyRow)) = 0 _
        And Len(Range("Q" & lngMyRow)) = 0 And Len(Range("R" & lngMyRow)) = 0 _
        And Len(Range("S" & lngMyRow)) = 0 And Len(Range("T" & lngMyRow)) = 0 Then
            Rows(lngMyRow).EntireRow.Delete
        End If
    Next lngMyRow

with this:

    Dim rng As Range
    For lngMyRow = lngLastRow To 3 Step -1
        Set rng = Range("E" & lngMyRow & ":T" & lngMyRow)
        If Application.CountA(rng) = 0 Then Rows(lngMyRow).Delete
    Next lngMyRow

Dear Joe , is there any code for listbox columns base on Sheet columns
Sheet11 Columns show in Listbox bcoz Class wise every time Sheets 11 Columns are changed. as you seen in code every time columns count are different.
thanks in advance

 

[Joe4]

Dear Joe , is there any code for listbox columns base on Sheet columns
Sheet11 Columns show in Listbox bcoz Class wise every time Sheets 11 Columns are changed. as you seen in code every time columns count are different.
thanks in advance

That is a whole different question, and should be posted in a new thread,