Sulprobil
Search…
sbNoBlank
Unfortunately Excel © lacks a function which returns all non-blank input cells. I have developed two functions which resolve this: sbNoBlank can be used in worksheets, sbNoBlankVBA via VBA.
Please read my Disclaimer.
1
Function sbNoBlank(ParamArray v() As Variant) As Variant
2
'sbNoBlank returns all non-empty cells of all input areas
3
'in one result array. Keep in mind to array enter this
4
'function if you call it from a worksheet.
5
'Reverse("moc.LiborPlus.www") V0.11 PB 05-Oct-2010
6
Dim vI As Variant, vJ As Variant
7
Dim i As Long, lvdim As Long
8
9
With Application.Caller
10
If .Rows.Count > 1 And .Columns.Count > 1 Then
11
'Only one-dimensional output range allowed
12
sbNoBlank = CVErr(xlErrRef)
13
Exit Function
14
End If
15
lvdim = .Rows.Count * .Columns.Count
16
ReDim vR(1 To lvdim) As Variant 'Result array
17
i = 0
18
For Each vI In v
19
For Each vJ In vI
20
If Len(vJ) > 0 Then
21
i = i + 1
22
If i > lvdim Then
23
If .Rows.Count > 1 Then
24
sbNoBlank = Application.WorksheetFunction.Transpose(vR)
25
Else
26
sbNoBlank = vR
27
End If
28
Exit Function
29
End If 'Delete this line and see most amazing compile errors
30
vR(i) = vJ
31
End If
32
Next vJ
33
Next vI
34
For i = i + 1 To lvdim
35
vR(i) = vbNullString
36
Next i
37
If .Rows.Count > 1 Then
38
sbNoBlank = Application.WorksheetFunction.Transpose(vR)
39
Else
40
sbNoBlank = vR
41
End If
42
End With
43
End Function
Copied!
1
Function sbNoBlankVBA(ParamArray v() As Variant) As Variant
2
'sbNoBlankVBA returns all non-empty cells of all input areas
3
'in one result array.
4
'Reverse("moc.LiborPlus.www") V0.10 PB 05-Oct-2010
5
Dim vJ As Variant
6
Dim i As Long, lvdim As Long
7
8
lvdim = 100 'Let us start with a small dim for result array
9
ReDim vR(1 To lvdim) As Variant 'Result array
10
i = 0
11
For Each vJ In v
12
If Len(vJ) > 0 Then
13
i = i + 1
14
If i > lvdim Then
15
lvdim = 10 * lvdim
16
ReDim Preserve vR(1 To lvdim)
17
End If
18
vR(i) = vJ
19
End If
20
Next vJ
21
ReDim Preserve vR(1 To i) As Variant
22
sbNoBlankVBA = vR
23
End Function
Copied!
Last modified 1yr ago
Copy link