Can VBA run without input box?

[motilulla]

Hi everybody,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I am using code below to generate random permutation. Once I run the code appears first input box with the message (select the elements to permute) where I select the elements from range =$A$2:$A$16 and accept the code, after appears second input box with the message (how many elements in each choice?) where I need to select 15 and accept the code, finally appears third input box with message (Enter the number of choices to display and the number of elements in each choice, separated by coma. where I need to select 10,15 and accept the code, and result displayed in cells C2:Q11.<o></o>
<o></o>

<o:p></o:p>

Option Explicit
Sub RandPerumteGen()
Sheets("Sheet1").Select
    Range("C2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.ClearContents
    Range("C2").Select
Dim i As Integer, j As Integer
Dim temp As Variant
Dim deflt As String
Static elementsPerChoice As Integer
Static numChoicesMade As Integer
Static elementsRay As Range
Dim selectFrom As Variant
Dim randIndex As Integer, maxIndex As Integer
Dim writeRay As Range
Rem get elements
    Rem input range
        If Not (elementsRay Is Nothing) Then _
        deflt = elementsRay.Address
        On Error Resume Next
        Set elementsRay = Application.InputBox _
                            ("Select the elements to permute.", _
                                Default:=deflt, _
                                Type:=8)
        If TypeName(elementsRay) <> "Range" Then Exit Sub
        On Error GoTo 0
        If Not (elementsRay.Rows.Count = 1 _
            Or elementsRay.Columns.Count = 1) _
            Then Beep: Exit Sub
    
    Rem range to array
        If elementsRay.Columns.Count = 1 Then
            selectFrom = Application.Transpose(elementsRay)
        Else
            Rem array handeling for my environment
            selectFrom = Application.Transpose(Application.Transpose(elementsRay))
        End If
Rem how many elements per choice
    If elementsPerChoice = 0 Then elementsPerChoice = 15
    deflt = CStr(elementsPerChoice)
    elementsPerChoice = Application.InputBox( _
                                "How many elements in each choice?", _
                                Default:=deflt, Type:=1)
    If elementsPerChoice = False Then Exit Sub
    If elementsPerChoice > elementsRay.Cells.Count Then _
                    elementsPerChoice = elementsRay.Cells.Count
Rem - - - - - - -Begin Edit  - - - - - - - - - - - - - - -
Rem input how many to show and length of permiutation
    If numChoicesMade = 0 Then numChoicesMade = 10
    If elementsPerChoice = 0 Then elementsPerChoice = 15
    deflt = CStr(numChoicesMade) & ", " & CStr(elementsPerChoice)
    Do
        temp = Application.InputBox( _
                    prompt:="Enter the number of choices to display and" _
                    & vbCrLf & vbTab & "the number of elements in each choice," _
                    & vbCrLf & vbTab & vbTab & "separated by a comma." _
                    & vbCrLf & vbCrLf & vbTab & "rows_displayed , elements_per_row", _
                    Default:=deflt, _
                    Type:=2)
        If temp = "False" Then Exit Sub
        On Error Resume Next
        j = Application.Search(",", temp, 2)
        On Error GoTo 0
    Loop Until j > 0
    numChoicesMade = Val(temp)
    elementsPerChoice = Val(Mid(temp, j + 1))
    If elementsPerChoice > elementsRay.Cells.Count Then _
        elementsPerChoice = elementsRay.Cells.Count
Rem where to start writing
    Set writeRay = ThisWorkbook.Sheets(1).Range("c2")
    Set writeRay = Range(writeRay, writeRay.Cells(1, elementsPerChoice))
Rem - - - - - - begin New Edit - - - - - - - - - - -
Rem where to start writing
    Set writeRay = ThisWorkbook.Sheets(1).Range("c2")
    Set writeRay = Range(writeRay, _
                    writeRay.Cells(numChoicesMade, elementsPerChoice))
Dim outputRRay As Variant
ReDim outputRRay(1 To numChoicesMade, 1 To elementsPerChoice)
Application.Calculation = xlManual
Application.ScreenUpdating = False
Rem permutation  routine
    For j = 1 To numChoicesMade
    
    Rem randomly re-order selectFrom
        maxIndex = UBound(selectFrom) + 1
        For i = 1 To elementsPerChoice
            randIndex = i + Int(Rnd() * (maxIndex - i))
            
            temp = selectFrom(randIndex)
            selectFrom(randIndex) = selectFrom(i)
            selectFrom(i) = temp
            
            outputRRay(j, i) = selectFrom(i)
        Next i
        
    Next j
    writeRay.Value = outputRRay
    
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

<o></o>
<o></o>
Please help to modified code that can run without input box selection with fix values for,<o></o>
First box fix input range =$A$2:$A$16<o></o>
Second box fix input 15<o></o>
Third box fix input 10,15<o></o>
And get random permute result always in cells C2:Q11<o></o>
<o></o>
Thanks And Regards,<o></o>
Moti<o></o>

 

[Andrew Poulsom]

Try these three amendments:

Set elementsRay = Range("A2:A16")
elementsPerChoice = 15
temp = "10,15"

 

[motilulla]

Hi Andrew Poulsom,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
Thank you very much for setting up input ranges fix and for quick replay, it is amazing you have solved in couple of minute, which I was trying to modify since one week now it is working, as I required.<o></o>
<o></o>
Thanks And Regards,<o></o>
Moti<o></o>