Friday, February 12, 2016

Excel VBA- Arrya To Delete blank rows

EXCEL VBA TO DELETE ALL BLANK ROWS USING ARRAY

Array provides faster way to delete blank rows from a sheet compared to looping the cells of the target range of the sheet. Excel VBA can be used to assign range to an array and vice versa. When a range is passed to an array, it must be remembered that the lower bound of the array begins with 1 even if option base is set to 0. We can also assign a range to an array. This flexibility about array in Excel VBA is exploited by the VBA programmers to deal with large set of data on a sheet. In case, if we have small set of data, the looping the cells of range and using array does not seem to be significant but in case of large data set, merit of array is clearly visible. The reason is that array uses data in the memory rather than on the disk. So, whenever we have to compute with the data, array should be preferred.
The following code can be used to remove blank rows of Sheet1. The desired data set is obtained at Sheet5 after processing.


Sub DeleteBlankRows()
    Dim varData
    Dim varResult
    Dim lngR As Long
    Dim lngK As Long
    Dim strRecord As String
    ReDim varResult(0)
    
    ThisWorkbook.Sheets("Export").UsedRange
    varData = ThisWorkbook.Sheets("Export").UsedRange
    
    For lngR = LBound(varData) To UBound(varData)
        strRecord = 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)
        If Len(strRecord) > 10 Then
            ReDim Preserve varResult(lngK)
            varResult(lngK) = strRecord
            lngK = lngK + 1

        End If
    Next
    Sheet5.Cells.Clear
    Sheet5.Range("A1:A" & lngK) = Application.Transpose(varResult)
    Sheet5.Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), _
        DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
        Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, _
        OtherChar:="|", TrailingMinusNumbers:=True
    Sheet5.Range("A1").CurrentRegion.Columns.AutoFit
lblError3:
If Err.Number <> 0 Then
    MsgBox "Error Number:" & Err.Number & vbCrLf & "Error Description: " & Err.Number
End If
Application.ScreenUpdating = True
End Sub

Hot Topics