Excel VBA- Delete blank rows

By Ajeet Kumar

EXCEL VBA TO DELETE BLANK ROWS USING DICTIONARY OBJECT

Sub pDelBlankRecByDix()
    
    Dim objDx As Object
    Dim strRec As String
    Dim varData
    Dim lngR As Long
    Dim lngK As Long
    Dim ItemsArr
    
    Application.ScreenUpdating = False
    On Error GoTo lblERR
    
    varData = Range("A1:M30")
    Set objDx = CreateObject("Scripting.Dictionary")
    
    For lngR = LBound(varData) To UBound(varData)
        strRec = varData(lngR, 1) & "|" & varData(lngR, 2) & "|" & varData(lngR, 3) & "|" & varData(lngR, 4) & "|" & _
            varData(lngR, 5) & "|" & varData(lngR, 6) & "|" & varData(lngR, 7) & "|" & varData(lngR, 8) & "|" & _
            varData(lngR, 9) & "|" & varData(lngR, 10) & "|" & varData(lngR, 11) & "|" & varData(lngR, 12) & "|" & varData(lngR, 13)

        If Len(strRec) > 12 Then
           lngK = lngK + 1
           objDx(lngK) = strRec
           Sheet2.Range("A" & lngK).Resize(1, 13) = Split(objDx(lngK), "|")
        End If

    Next
    
    With Sheet2.Range("A1").CurrentRegion
        .Value = Sheet2.Range("A1").CurrentRegion.Value
        .Columns.AutoFit
        .Borders.LineStyle = xlContinuous
    End With
    MsgBox "Blank Rows Removed.", vbInformation
    
lblERR:

If Err.Number <> 0 Then
    MsgBox "Error Number:" & Err.Number & vbCrLf & "Error Description: " & Err.Number
End If

Application.ScreenUpdating = True

End Sub