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

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

Open in new window

0
thmh
Asked:
thmh
  • 7
  • 7
1 Solution
 
MSmaxImplementation ConsultantCommented:
hi you can try my solution, see file attached.
Boook.xls
0
 
thmhAuthor 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
 
sijpieCommented:
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

Open in new window

0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
thmhAuthor Commented:
hy sijpie,
your solution returned value error

0
 
sijpieCommented:
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

Open in new window

0
 
thmhAuthor Commented:
did test new code and it  excludes empty cells but blank cells are still calculated
0
 
sijpieCommented:
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

Open in new window

0
 
thmhAuthor 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
 
sijpieCommented:
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
 
thmhAuthor Commented:
it's example with column B ,may data is differently arranged , here is workbook with example
Book87.xls
0
 
sijpieCommented:
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
 
thmhAuthor 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
 
sijpieCommented:
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

Open in new window

0
 
sijpieCommented:
Has my solution worked for you? It works perfectloy on my test ranges.
0
 
thmhAuthor Commented:
tnx works perfect , sory for delay
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

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