Here is a code which do not use worksheet functions but do the same work:
Code:
Option Explicit
Sub LMP_Test()
Dim rngRange As Range
Dim varArrData() As Variant
Dim varArrDataFinal() As Variant
Dim lngCount As Long
Dim lngLoop As Long
Const strDataSheetName As String = "Sheet1" 'Change accordingly
Const strDataCell As String = "A1" 'Change accordingly
Const strDataResultCell As String = "B1" 'Change accordingly
With ThisWorkbook.Worksheets(strDataSheetName)
Set rngRange = .Range(strDataCell)
Set rngRange = .Range(rngRange, .Cells(.Rows.Count, rngRange.Column).End(xlUp))
If rngRange.Rows.Count > 1 Then
varArrData = rngRange.Value
Else
ReDim varArrData(1 To 1, 1 To 1)
varArrData(1, 1) = rngRange.Value
End If
Set rngRange = .Range(strDataResultCell)
lngCount = 0
rngRange.EntireColumn.ClearContents
For lngLoop = LBound(varArrData) To UBound(varArrData)
If Len(Trim(varArrData(lngLoop, 1))) > 0 Then
rngRange.Offset(lngCount).Value = varArrData(lngLoop, 1)
lngCount = lngCount + 1
End If
Next lngLoop
End With
Set rngRange = Nothing
Erase varArrData
Erase varArrDataFinal
lngCount = Empty
lngLoop = Empty
End Sub
Bookmarks