Help with VBA to "shuffle cells" for a fixture list (edit to control variables)

[JDoc27]

Hi,

I have a VBA that will happily shuffle cells within a column, I am looking to expand on this and have it shuffle across rows of 2 also as I need it to create fixtures from a list on a regular basis, therefore I need Home and Away teams changing on a weekly basis.

This is the current code I have (I realise I cannot use the FOR control again as it won't let me, I hopefully need the workaround):


Private Sub CommandButton1_Click()
Call Shuffle
End Sub


Sub Shuffle()
Dim rng As Range
Dim num_rows As Integer
Dim num_cols As Integer
Dim temp() As Object
Dim row As Integer
Dim col As Integer
Dim swap_row As Integer
Dim temp_object As String



Set rng = Application.Selection
num_rows = rng.Rows.Count
num_cols = rng.Columns.Count

If ((num_rows < 2) Or (num_cols < 1)) Then
MsgBox "You must select at least 2 rows and 1 column."
Exit Sub
End If


For row = 1 To num_rows - 1

swap_row = row + CInt(Int((num_rows - row + 1) * Rnd()))


If (row <> swap_row) Then
For col = 1 To num_cols
temp_object = rng(row, col)
rng(row, col) = rng(swap_row, col)
rng(swap_row, col) = temp_object

Next col
End If
Next row
End Sub