Solved

exclude blank from range excel

Posted on 2010-08-29
15
740 Views
Last Modified: 2012-05-10
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
Comment
Question by:thmh
  • 7
  • 7
15 Comments
 
LVL 7

Expert Comment

by:MSmax
ID: 33552832
hi you can try my solution, see file attached.
Boook.xls
0
 

Author Comment

by:thmh
ID: 33560872
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
 
LVL 6

Expert Comment

by:sijpie
ID: 33585371
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
 

Author Comment

by:thmh
ID: 33588546
hy sijpie,
your solution returned value error

0
 
LVL 6

Expert Comment

by:sijpie
ID: 33594105
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
 

Author Comment

by:thmh
ID: 33597155
did test new code and it  excludes empty cells but blank cells are still calculated
0
 
LVL 6

Expert Comment

by:sijpie
ID: 33609343
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Author Comment

by:thmh
ID: 33625887
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
 
LVL 6

Expert Comment

by:sijpie
ID: 33634012
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 Comment

by:thmh
ID: 33663956
it's example with column B ,may data is differently arranged , here is workbook with example
Book87.xls
0
 
LVL 6

Expert Comment

by:sijpie
ID: 33666928
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 Comment

by:thmh
ID: 33685077
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
 
LVL 6

Accepted Solution

by:
sijpie earned 100 total points
ID: 33707340
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
 
LVL 6

Expert Comment

by:sijpie
ID: 33728501
Has my solution worked for you? It works perfectloy on my test ranges.
0
 

Author Closing Comment

by:thmh
ID: 33728794
tnx works perfect , sory for delay
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
DBF to ... Converter 5 32
Excel 2010 Text Formatting placing a hyphen in front of text 3 20
Help with Syntax 9 26
Sum iF  based on a null cell 11 29
Go is an acronym of golang, is a programming language developed Google in 2007. Go is a new language that is mostly in the C family, with significant input from Pascal/Modula/Oberon family. Hence Go arisen as low-level language with fast compilation…
Whether you’re a college noob or a soon-to-be pro, these tips are sure to help you in your journey to becoming a programming ninja and stand out from the crowd.
The viewer will be introduced to the member functions push_back and pop_back of the vector class. The video will teach the difference between the two as well as how to use each one along with its functionality.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

919 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now