• Status: Solved
• Priority: Medium
• Security: Public
• Views: 833

# exclude blank from range excel

hy,
have udf to generate random numbers from range , issue is my range have blank cells (formula calculated) , need to exclude blank cells

=RandomSelection(\$A\$2:\$A\$61)
``````Option Explicit
Function RandomSelection(aRng As Range)
Dim myTarg As Range, _
SrcList, Rslt(), _
i As Long, j As Long, k As Long
Application.Volatile
SrcList = aRng.Value
Set myTarg = Application.Caller
With myTarg
If .Areas.Count > 1 Then
RandomSelection = _
"Function can be used only in a single contiguous range"
Exit Function   '<<<<<
End If
If .Rows.Count > 1 And .Columns.Count > 1 Then
RandomSelection = _
"Selected cells must be in a single row or column"
Exit Function   '<<<<<
End If
If .Cells.Count > aRng.Cells.Count Then
RandomSelection = _
"Range specified as argument must contain more cells than output selection"
Exit Function   '<<<<<
End If
ReDim Rslt(1 To IIf(.Rows.Count > 1, .Rows.Count, .Columns.Count))
End With
j = UBound(SrcList, 1)
For i = LBound(Rslt) To UBound(Rslt)
k = Int(Rnd() * (j - LBound(SrcList, 1) + 1)) + LBound(SrcList, 1)
Rslt(i) = SrcList(k, 1)
SrcList(k, 1) = SrcList(j, 1)
j = j - 1
Next i
If myTarg.Rows.Count > 1 Then
RandomSelection = Application.WorksheetFunction.Transpose(Rslt)
Else
RandomSelection = Rslt
End If
End Function
``````
0
thmh
• 7
• 7
1 Solution

Implementation ConsultantCommented:
hi you can try my solution, see file attached.
Boook.xls
0

Author Commented:
hy MSmax,

i did tray it but i need something ells ,
i got grid B1:WFC66 filed with formula   =RandomSelection(sheet1\$A\$2:\$A\$61)  , and problem is range sheet1\$A\$2:\$A\$61 is filed with formula
A
1 =IF(COUNTBLANK(\$M\$2:\$M\$61)-COUNTBLANK(\$L\$2:\$L\$61)=0;1;IF(\$M\$2<>"";"";IF(\$B\$2="";"";1)))
2 =IF(COUNTBLANK(\$M\$2:\$M\$61)-COUNTBLANK(\$L\$2:\$L\$61)=0;2;IF(\$M\$3<>"";"";IF(\$B\$3="";"";2)))
3 =IF(COUNTBLANK(\$M\$2:\$M\$61)-COUNTBLANK(\$L\$2:\$L\$61)=0;3;IF(\$M\$4<>"";"";IF(\$B\$4="";"";3)))
4 ...

so range of random numbers is between 1-60 , if range \$A\$2:\$A\$61 is without blanks
0

Commented:
You need to check the value of the cell to see if blank (the following code starts from your code line 28):

``````For i = LBound(Rslt) To UBound(Rslt)
k = Int(Rnd() * (j - LBound(SrcList, 1) + 1)) + LBound(SrcList, 1)
if SrcList(k,1).value <> vbNullstring then Rslt(i) = SrcList(k, 1)
SrcList(k, 1) = SrcList(j, 1)
j = j - 1
Next i
``````
0

Author Commented:
hy sijpie,
your solution returned value error

0

Commented:
OK, I've been really using your code and experimenting.

The problem you have is that with the statement
SrcList = aRng.Value
any blanks in aRng are given the value 0 in SrcList.

So later on you can't distinguish between blanks in the list and possible 0 entered as a choice.

If your random picklist does not contain 0, then you can test for 0 and skip. Else 0 will pop up a bit more frequent than random...

here is the code to check for 0 and skip
``````Function RandomSelection(aRng As Range)
Dim myTarg As Range, _
SrcList, Rslt(), _
i As Long, j As Long, k As Long, m As String
Application.Volatile
SrcList = aRng.Value
Set myTarg = Application.Caller
With myTarg
If .Areas.Count > 1 Then
RandomSelection = _
"Function can be used only in a single contiguous range"
Exit Function   '<<<<<
End If
If .Rows.Count > 1 And .Columns.Count > 1 Then
RandomSelection = _
"Selected cells must be in a single row or column"
Exit Function   '<<<<<
End If
If .Cells.Count > aRng.Cells.Count Then
RandomSelection = _
"Range specified as argument must contain more cells than output selection"
Exit Function   '<<<<<
End If
ReDim Rslt(1 To IIf(.Rows.Count > 1, .Rows.Count, .Columns.Count))
End With
j = UBound(SrcList, 1)

For i = LBound(Rslt) To UBound(Rslt)
NextI:
k = Int(Rnd() * (j - LBound(SrcList, 1) + 1)) + LBound(SrcList, 1)

If SrcList(k, 1) = 0 Then GoTo NextI
Rslt(i) = SrcList(k, 1)
SrcList(k, 1) = SrcList(j, 1)
j = j - 1

Next i
If myTarg.Rows.Count > 1 Then
RandomSelection = Application.WorksheetFunction.Transpose(Rslt)
Else
RandomSelection = Rslt
End If
End Function
``````
0

Author Commented:
did test new code and it  excludes empty cells but blank cells are still calculated
0

Commented:
OK corrected code below. Added a check to exclude "" (vbNullString which means empty string)

I have also added a piece of code to check if not all cells are blank, as then the function would loop without end.
``````Option Explicit
Function RandomSelection(aRng As Range)
Dim myTarg As Range, _
SrcList, Rslt(), _
i As Long, j As Long, k As Long, m As String
Application.Volatile
SrcList = aRng.Value
Set myTarg = Application.Caller
With myTarg
If .Areas.Count > 1 Then
RandomSelection = _
"Function can be used only in a single contiguous range"
Exit Function   '<<<<<
End If
If .Rows.Count > 1 And .Columns.Count > 1 Then
RandomSelection = _
"Selected cells must be in a single row or column"
Exit Function   '<<<<<
End If
If .Cells.Count > aRng.Cells.Count Then
RandomSelection = _
"Range specified as argument must contain more cells than output selection"
Exit Function   '<<<<<
End If
ReDim Rslt(1 To IIf(.Rows.Count > 1, .Rows.Count, .Columns.Count))
End With
If Application.WorksheetFunction.Sum(aRng) = 0 Then
RandomSelection = "Range does not contain values"
Exit Function
End If
j = UBound(SrcList, 1)

For i = LBound(Rslt) To UBound(Rslt)
NextI:
k = Int(Rnd() * (j - LBound(SrcList, 1) + 1)) + LBound(SrcList, 1)

If SrcList(k, 1) = 0 Or SrcList(k, 1) = vbNullString Then GoTo NextI
Rslt(i) = SrcList(k, 1)
SrcList(k, 1) = SrcList(j, 1)
j = j - 1

Next i
If myTarg.Rows.Count > 1 Then
RandomSelection = Application.WorksheetFunction.Transpose(Rslt)
Else
RandomSelection = Rslt
End If
End Function
``````
0

Author Commented:
hy ,
seams code works with normal formulas , but there is issue with array formulas ,
example:
putting formula in array B1:B8 and data is in range A1:A18 , if there is lees then 8 values in data range formula will get in loop and excel to "no responding"
is there solution for this issue
0

Commented:
to get out of the loop, press Ctrl-Break (the button above the Page-up button and next to Scroll-Lock button). This will stop the macro running.

I don't understand how you can have the formulas in column B. Earlier you say column B holds some other data that the formulas in column A refer to:
=IF(COUNTBLANK(\$M\$2:\$M\$61)-COUNTBLANK(\$L\$2:\$L\$61)=0;1;IF(\$M\$2<>"";"";IF(\$B\$2="";"";1)))

Also i don't understand what you mean with 'there is an issue with array formulas'.

Can yuou post your spreadsheet with the problem?
0

Author Commented:
it's example with column B ,may data is differently arranged , here is workbook with example
Book87.xls
0

Commented:
Well,now I understand. Also why it gets into a loop. YOur array of array functions is 8 cells, so it needs at least 8 values to pick from, else it it can't generate an answer.

My next question is then why / how would you want to create 8 non-duplicate values from less than 8 in the pick list?

But my real question is: why does using the array formula (entering with shift-ctrl pressed) not produce duplicates? That is what I don't understand. Maybe you  can explain, in which case maybe I can find a way in which to allow less items in the source array and have the result show #NA in some cells then.
0

Author Commented:
here is web page with code

http://www.tushar-mehta.com/excel/newsgroups/rand_selection/#from_array

i didn't write function ,
returning #NA is fine , anything except loop
0

Commented:
What about if we first check to see that the rows in the array are less than the rows containing data in the selection range?

``````Function RandomSelection(aRng As Range)
Dim myTarg As Range, _
SrcList, Rslt(), _
i As Long, j As Long, k As Long, m As String
Application.Volatile
SrcList = aRng.Value
Set myTarg = Application.Caller
With myTarg
If .Areas.Count > 1 Then
RandomSelection = _
"Function can be used only in a single contiguous range"
Exit Function   '<<<<<
End If
If .Rows.Count > 1 And .Columns.Count > 1 Then
RandomSelection = _
"Selected cells must be in a single row or column"
Exit Function   '<<<<<
End If
If .Cells.Count > aRng.Cells.Count Or .Cells.Count > Application.WorksheetFunction.Count(Range(aRng.Address)) Then
RandomSelection = _
"Range specified as argument must contain more cells than output selection"
Exit Function   '<<<<<
End If
ReDim Rslt(1 To IIf(.Rows.Count > 1, .Rows.Count, .Columns.Count))
End With
If Application.WorksheetFunction.Sum(aRng) = 0 Then
RandomSelection = "Range does not contain values"
Exit Function
End If
j = UBound(SrcList, 1)

For i = LBound(Rslt) To UBound(Rslt)
NextI:
k = Int(Rnd() * (j - LBound(SrcList, 1) + 1)) + LBound(SrcList, 1)

If SrcList(k, 1) = 0 Or SrcList(k, 1) = vbNullString Then GoTo NextI
Rslt(i) = SrcList(k, 1)
SrcList(k, 1) = SrcList(j, 1)
j = j - 1

Next i
If myTarg.Rows.Count > 1 Then
RandomSelection = Application.WorksheetFunction.Transpose(Rslt)
Else
RandomSelection = Rslt
End If
End Function
``````
0

Commented:
Has my solution worked for you? It works perfectloy on my test ranges.
0

Author Commented:
tnx works perfect , sory for delay
0

## Featured Post

• 7
• 7
Tackle projects and never again get stuck behind a technical roadblock.