Random Number

[Sanjayaranj]

Hi Everybody ,
I need a help .
How to generate random numbers with some conditions.

Conditions
1. using these numbers.
1 3 4 7 9 10 11 14 15 18 19 21 24 25

2.I don’t need this pairs in a row
1 4
1 11
1 14
4 7
4 14
4 25
15 18
15 19
21 25

3. I need six numbers in a row


Examples

1 5 7 10 18 19 Correct
1 3 4 21 24 25 Incorrect
4 5 7 15 18 19 Incorrect
5 9 14 19 24 25 Correct



Any formulla? Or VBA code for this type .

 

[Sanjayaranj]

I improved my macro, it lists only the correct sets in columns D:I (beginning in D5:I5)
It uses the layout above: Numbers in A2:N2; Exclusion list in A5:B13

Sub aTestV2()
    Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
    Dim lLin As Long, lResult(1 To 6) As Long
    Dim rData As Range, rExclusion As Range
  
    Set rData = Range("A2:N2")
    Set rExclusion = Range("A5:B13")
    lLin = 4
    For i = 1 To 9
            For j = i + 1 To 10
                For k = j + 1 To 11
                    For l = k + 1 To 12
                        For m = l + 1 To 13
                            For n = m + 1 To 14
                                lResult(1) = Application.Index(rData, i)
                                lResult(2) = Application.Index(rData, j)
                                lResult(3) = Application.Index(rData, k)
                                lResult(4) = Application.Index(rData, l)
                                lResult(5) = Application.Index(rData, m)
                                lResult(6) = Application.Index(rData, n)
                                If CheckExclusion(lResult, rExclusion) = False Then
                                    lLin = lLin + 1
                                    Range("D" & lLin).Resize(1, 6) = lResult
                                End If
                            Next n
                        Next m
                    Next l
                Next k
            Next j
        Next i
End Sub

Function CheckExclusion(lRes() As Long, rExclusion As Range) As Boolean
    Dim rCell As Range
  
    For Each rCell In rExclusion
        If Not IsError(Application.Match(rCell.Value, lRes, 0)) Then
            If Not IsError(Application.Match(rCell.Offset(, 1).Value, lRes, 0)) Then
                CheckExclusion = True
                Exit For
            End If
        End If
    Next rCell
End Function[
[/QUOTE]
Sanjayaranj,

If you need to generate all the possibilities, this makes the code much more complex - I don't know how to calculate how many different sets would be possible (???)

I'm afraid I don't know how to do this.

M.
[/QUOTE]
Thank you Marcelo.

Another improvement - a little bit faster macro

Sub aTestV3()
    Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
    Dim lLin As Long, lResult(1 To 6) As Long
    Dim rData As Range, rExclusion As Range
   
    Set rData = Range("A2:N2")
    Set rExclusion = Range("A5:B13")
    lLin = 4
    For i = 1 To 9
        lResult(1) = Application.Index(rData, i)
        For j = i + 1 To 10
            lResult(2) = Application.Index(rData, j)
            For k = j + 1 To 11
                lResult(3) = Application.Index(rData, k)
                For l = k + 1 To 12
                    lResult(4) = Application.Index(rData, l)
                    For m = l + 1 To 13
                        lResult(5) = Application.Index(rData, m)
                        For n = m + 1 To 14
                            lResult(6) = Application.Index(rData, n)
                            If CheckExclusion(lResult, rExclusion) = False Then
                                lLin = lLin + 1
                                Range("D" & lLin).Resize(1, 6) = lResult
                            End If
                        Next n
                    Next m
                Next l
                Next k
            Next j
        Next i
End Sub

Function CheckExclusion(lRes() As Long, rExclusion As Range) As Boolean
    Dim rCell As Range
   
    For Each rCell In rExclusion
        If Not IsError(Application.Match(rCell.Value, lRes, 0)) Then
            If Not IsError(Application.Match(rCell.Offset(, 1).Value, lRes, 0)) Then
                CheckExclusion = True
                Exit For
            End If
        End If
    Next rCell
End Function

M.

Another improvement - a little bit faster macro

Sub aTestV3()
    Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
    Dim lLin As Long, lResult(1 To 6) As Long
    Dim rData As Range, rExclusion As Range
   
    Set rData = Range("A2:N2")
    Set rExclusion = Range("A5:B13")
    lLin = 4
    For i = 1 To 9
        lResult(1) = Application.Index(rData, i)
        For j = i + 1 To 10
            lResult(2) = Application.Index(rData, j)
            For k = j + 1 To 11
                lResult(3) = Application.Index(rData, k)
                For l = k + 1 To 12
                    lResult(4) = Application.Index(rData, l)
                    For m = l + 1 To 13
                        lResult(5) = Application.Index(rData, m)
                        For n = m + 1 To 14
                            lResult(6) = Application.Index(rData, n)
                            If CheckExclusion(lResult, rExclusion) = False Then
                                lLin = lLin + 1
                                Range("D" & lLin).Resize(1, 6) = lResult
                            End If
                        Next n
                    Next m
                Next l
                Next k
            Next j
        Next i
End Sub

Function CheckExclusion(lRes() As Long, rExclusion As Range) As Boolean
    Dim rCell As Range
   
    For Each rCell In rExclusion
        If Not IsError(Application.Match(rCell.Value, lRes, 0)) Then
            If Not IsError(Application.Match(rCell.Offset(, 1).Value, lRes, 0)) Then
                CheckExclusion = True
                Exit For
            End If
        End If
    Next rCell
End Function

M.

I know you spent a lot of time picking out the perfect code.thanks genius ?

 

[Eric W]

As it could be done without any Dictionary so I'm surprised to see Eric you need two copies …

I didn't necessarily "need" two dictionaries. A dictionary is a data structure that seemed appropriate for parts of my design. I could have come up with another way if I'd had to. I looked at your macro from the link you posted. True, you didn't use dictionaries, but you also didn't have to worry about the excluded combinations. That would have required some kind of a redesign on your part.

Transposing here is not a concern but for some large combinations # like in post #11 link it's a no way …

I'm aware of the size limitations of TRANSPOSE. As you noted, that was not a consideration for this request. There are other methods that work which I have used when needed. I've written macros that generate combinations that span multiple sheets because the number of results exceeded the number of rows/columns on a single sheet. But you don't get out the jackhammer first, when all you need is a pushpin.


@Sanjayaranj , I'm glad we could help!

 

[Sanjayaranj]

I improved my macro, it lists only the correct sets in columns D:I (beginning in D5:I5)
It uses the layout above: Numbers in A2:N2; Exclusion list in A5:B13

Sub aTestV2()
    Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
    Dim lLin As Long, lResult(1 To 6) As Long
    Dim rData As Range, rExclusion As Range
 
    Set rData = Range("A2:N2")
    Set rExclusion = Range("A5:B13")
    lLin = 4
    For i = 1 To 9
            For j = i + 1 To 10
                For k = j + 1 To 11
                    For l = k + 1 To 12
                        For m = l + 1 To 13
                            For n = m + 1 To 14
                                lResult(1) = Application.Index(rData, i)
                                lResult(2) = Application.Index(rData, j)
                                lResult(3) = Application.Index(rData, k)
                                lResult(4) = Application.Index(rData, l)
                                lResult(5) = Application.Index(rData, m)
                                lResult(6) = Application.Index(rData, n)
                                If CheckExclusion(lResult, rExclusion) = False Then
                                    lLin = lLin + 1
                                    Range("D" & lLin).Resize(1, 6) = lResult
                                End If
                            Next n
                        Next m
                    Next l
                Next k
            Next j
        Next i
End Sub

Function CheckExclusion(lRes() As Long, rExclusion As Range) As Boolean
    Dim rCell As Range
 
    For Each rCell In rExclusion
        If Not IsError(Application.Match(rCell.Value, lRes, 0)) Then
            If Not IsError(Application.Match(rCell.Offset(, 1).Value, lRes, 0)) Then
                CheckExclusion = True
                Exit For
            End If
        End If
    Next rCell
End Function[
[/QUOTE]
Sanjayaranj,

If you need to generate all the possibilities, this makes the code much more complex - I don't know how to calculate how many different sets would be possible (???)

I'm afraid I don't know how to do this.

M.
[/QUOTE]
Thank you Marcelo.

Sanjayaranj,

If you need to generate all the possibilities, this makes the code much more complex - I don't know how to calculate how many different sets would be possible (???)

I'm afraid I don't know how to do this.

M.

Thank you

I didn't necessarily "need" two dictionaries. A dictionary is a data structure that seemed appropriate for parts of my design. I could have come up with another way if I'd had to. I looked at your macro from the link you posted. True, you didn't use dictionaries, but you also didn't have to worry about the excluded combinations. That would have required some kind of a redesign on your part.


I'm aware of the size limitations of TRANSPOSE. As you noted, that was not a consideration for this request. There are other methods that work which I have used when needed. I've written macros that generate combinations that span multiple sheets because the number of results exceeded the number of rows/columns on a single sheet. But you don't get out the jackhammer first, when all you need is a pushpin.


@Sanjayaranj , I'm glad we could help!

Thank you for your help Eric?

 

[Marc L]

That would have required some kind of a redesign on your part.

Just two additional arrays for pairs …​

 

[Eric W]

Just two additional arrays for pairs …​

And I don't believe you could use the COMBIN function to set the size of your output array, unless you're happy with many empty rows.

 

[Marc L]

​

As it's very not a concern according to Excel / VBA basics ! (If you have well read my procedure using Resize statement …)​

​

Marcelo stated for speed concern but for such few combinations the result should be near to instant in less than 0.3 second, on your side ?​

 

[Marcelo Branco]

Marc

"Marcelo stated for speed concern but for such few combinations the result should be near to instant in less than 0.3 second, on your side ?"

An old machine, but a good one:
Dell iCore5 16GB RAM
Windows 7 Home Premium
Excel 2010 32 bits

aTestV2 0.98 seconds
aTestV3 0.80 seconds

Not a significant difference, but always important to improve the code, isn't it?

M.

 

[Marc L]

​

Pretty good …​

​

You can divide by 2 maybe 3 just storing the result in an array in order to write it at once to the worksheet rather than cell by cell like in my link …​

(Less than 0.3 s on an old i3 laptop)​

 

[Marcelo Branco]

Yes, i thought about it but as my code's performance was, say, "decent", I went to look at other threads

M.

 

[Marc L]

​

In fact I asked Eric about performance as recently on another forum the dictionary way was more than 3 times slower than a classic array way …​

Here with such few combinations it's not a concern.​

A trick with big huge large data >400k or 500k : using a VBA Collection is faster than with a Dictionary …​