Tuesday, February 16, 2016

Excel VBA- Array To Remove Blank Rows

EXCEL VBA TO REMOVE BLANK ROWS USING ARRAYS

Sub DelBlnkRwsByArr()
    Dim varData
    Dim varResult()
    Dim lngR As Long
    Dim lngC As Long
    Dim R As Long
    Dim S As Long
    
    On Error GoTo Err1
    
    ThisWorkbook.Sheets("Export").UsedRange
    varData = ThisWorkbook.Sheets("Export").UsedRange
    
    ReDim varResult(1 To UBound(varData, 1), 1 To UBound(varData, 2))
    
    For lngR = LBound(varData, 1) To UBound(varData, 1)
        S = 0
        For lngC = LBound(varData, 2) To UBound(varData, 2)
            S = S + Len(varData(lngR, lngC))
            If S > 0 Then
                Exit For
            End If
        Next
        If S > 0 Then
            R = R + 1
            For lngC = LBound(varData, 2) To UBound(varData, 2)
                varResult(R, lngC) = varData(lngR, lngC)
            Next
        End If
    Next
    
    ShtDest.Range("A:Z").ClearContents
    ShtDest.Range("A1").Resize(UBound(varResult, 1), UBound(varResult, 2)) = varResult

    Erase varData

    Erase varResult

Err1:

If Err.Number <> 0 Then
    MsgBox "Error Number:" & Err.Number & vbCrLf & "Error Description: " & Err.Number
End If
Application.ScreenUpdating = True
End Sub

Hot Topics