Can vba write mode be changed in column instead of rows?

[motilulla]

Hi everybody,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
The code below select elements to permute from range cells A2:A16 and start writing the first permutation in row 2 in cell C2 to Q2, and second permutation in row 3,and continue till end up to row 11,

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 = Range("A2:A16")
        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 = 15
    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 = "10,15"
        
        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:p>

</o>
<o></o>
Please I need help to change the code instead writing first permutation in row 2 in cell C2 to Q2, start writing in column 3 in cells C2 to C11, and continue till end in next columns up to 12.<o></o>
<o></o>
<o></o>
Thanks And Regards,<o></o>
Moti <o></o>

 

[mikerickson]

The use of Rem and the variable names makes that look like my code.
I remember writing a routine like that a few years ago.

Someone modified the section where the number of elements selected and the rows output can be chosen to the default 15,10.

To transpose the output, change the end of the routine to

    Next j
    Rem writeRay.Value = outputRRay:' old code

    Rem New code
    With writeRay
        .Resize(UBound(outputRRay, 2), UBound(outputRRay, 1)).Value = Application.Transpose(outputRRay)
    End With
    
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Do you want the 15,10 or would you like me to restore that feature?

 

[motilulla]

Hi mikerickson,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
First of all I want to thank you very much for your kind help. Secondly I want to congratulate for you memory that it not look like your code, it is only and only your code which you wrote in thread link given below.<o></o>
<o></o>
http://www.mrexcel.com/forum/showthread.php?t=252597&highlight=permutation&page=2<o></o>
<o></o>
Mar 17th, 2007, 11:32 PM Post #19, and made new edit in Post #22, Mar 19th, 2007, 03:29 PM <o></o>
<o></o>
Regarding the section where the number of elements selected and the rows output can be chosen<o></o>
Few days back I asked to fix these values as default ref to link below.<o></o>
http://www.mrexcel.com/forum/showthread.php?t=502987<o></o>
<o></o>
I have your full masterpiece code.<o></o>
<o></o>
Thank you once again giving solution for the request, to transpose the output, it is working as per my wish<o></o>
<o></o>
Thanks and regards,<o></o>
Moti<o></o>