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
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