ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Shuffle the cells! (https://www.excelbanter.com/excel-programming/336173-shuffle-cells.html)

M H

Shuffle the cells!
 
A question for interest:
The first row contains 8 words, one in each column. I want to shuffle
them randomly and display the results on the rows below. Presumably I
would expect to have 64 (8 x 8) combinations in this case. The problem
appears to be much difficult to be solved by VBA than I expected.
Furthermore, how to generalize the shuffling process for more words?

*** Sent via Developersdex http://www.developersdex.com ***

Tom Ogilvy

Shuffle the cells!
 
See John Walkenbach's site:

http://j-walk.com/ss/excel/tips/tip46.htm
Generating Permutations.

You would be generating all the permutations for 8 objects, which is 8
factorial or 40,320. So I would see your expectations as being a little off
unless you don't want every unique shuffle.

--
Regards,
Tom Ogilvy

"M H" wrote in message
...
A question for interest:
The first row contains 8 words, one in each column. I want to shuffle
them randomly and display the results on the rows below. Presumably I
would expect to have 64 (8 x 8) combinations in this case. The problem
appears to be much difficult to be solved by VBA than I expected.
Furthermore, how to generalize the shuffling process for more words?

*** Sent via Developersdex http://www.developersdex.com ***




M H

Shuffle the cells!
 
Gee, it's great and even works for 2-byte characters! Yes, Tom, I'm
really underestimating the permutations. Seems I have to go back to high
school math class! Thank you and JK for the great already-here help.


*** Sent via Developersdex http://www.developersdex.com ***

cory

Shuffle the cells!
 
Try the following code. Based on the ActiveCell, it will shuffle everything
forward in a continuous row until an empty cell is found and output in on the
next row.

------------------------------------------------
Option Base 1
------------------------------------------------
Sub Shuffle()

Dim myWords As Single
Dim myArray() As Single
Dim myNumber As Single
Dim myNumberCount As Single
Dim i As Integer

'Find the number of words to be shuffled
myWords = ActiveCell.End(xlToRight).Column - ActiveCell.Column + 1
'Create an array to hold the random number index
ReDim myArray(myWords)
Randomize
myNumberCount = 0
'Fill the array
While myNumberCount < myWords
'Find a random number between 1 and the total number of words
myNumber = Int(myWords * Rnd + 1)
'Add the random number to the array if it isn't already there
If Not NumberFound(myNumber, myArray) Then
myNumberCount = myNumberCount + 1
myArray(myNumberCount) = myNumber
End If
Wend

'Output the shuffled words one line down from the ordered words using
' the random index array created above
For i = 1 To UBound(myArray)
ActiveCell.Offset(1, i - 1).Value = ActiveCell.Offset(0, myArray(i)
- 1)
Next i

End Sub
------------------------------------------------
Function NumberFound(SearchNumber As Single, NumberArray As Variant) As
Boolean

Dim i As Integer

NumberFound = False

'Loop through each element in the array to see if
' SearchNumber exists in the array
For i = 1 To UBound(NumberArray)
If SearchNumber = NumberArray(i) Then
NumberFound = True
Exit For
End If
Next i

End Function
------------------------------------------------

STEVE BELL

Shuffle the cells!
 
I did something like this a long time ago.
The trick is to generate random numbers between 1 & 8 (or however many
columns)
Assume that the word list is on row 1 columns 1 - 8

You can generate an outer For Next loop that you can use to transfer the
results to multiple rows.
dim y as long
For y = 1 to 100

Next

This worked in Excel 2k. I repeated it about 50 times
and it looked fairly random...

Dim rand As Integer, x As Integer

For x = 1 To 8
Do Until Len(Cells(2, x)) 0
rand = Int((8 * Rnd) + 1)
If WorksheetFunction.CountIf(Rows(2), Cells(1, rand)) = 0 Then
Cells(2, x) = Cells(1, rand)
End If
Loop
Next

You can generate an outer For Next loop that you can use to transfer the
results to multiple rows.

dim y as long
For y = 2 to 100
For x = 1 To 8
Do Until Len(Cells(2, x)) 0
rand = Int((8 * Rnd) + 1)
If WorksheetFunction.CountIf(Rows(2), Cells(1, rand)) = 0 Then
Cells(y, x) = Cells(1, rand)
End If
Loop

Next

--
steveB

Remove "AYN" from email to respond
"M H" wrote in message
...
A question for interest:
The first row contains 8 words, one in each column. I want to shuffle
them randomly and display the results on the rows below. Presumably I
would expect to have 64 (8 x 8) combinations in this case. The problem
appears to be much difficult to be solved by VBA than I expected.
Furthermore, how to generalize the shuffling process for more words?

*** Sent via Developersdex http://www.developersdex.com ***





All times are GMT +1. The time now is 04:22 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com