Randomly rearrange 4 columns for each row

[JJS11]

Hello:

I am looking to write a VBA macro that will allow me to rearrange 4 columns randomly for each row of data. For example:

Name	Off1	Off2	Off3	Off4
John	10	100	25	5
Mary	100	100	25	50
Sue	50	10	50	100
Mark	50	75	100	5

<tbody>
</tbody>

The problem I have though is when I try to randomly arrange them with a range, I get duplicates and I cannot. I need all four to just be randomly arranged per person.

Any help is appreciated!

 

[JLGWhiz]

Hello:

I am looking to write a VBA macro that will allow me to rearrange 4 columns randomly for each row of data. For example:

Name	Off1	Off2	Off3	Off4
John	10	100	25	5
Mary	100	100	25	50
Sue	50	10	50	100
Mark	50	75	100	5

<tbody>
</tbody>

The problem I have though is when I try to randomly arrange them with a range, I get duplicates and I cannot. I need all four to just be randomly arranged per person.

Any help is appreciated!

I suspect it would be just as easy to do it manually, since only four columns per row would not allow the Excel random function to give truly random results. It would be susceptible to repetitive output because of limited seed values.

 

[JJS11]

I suspect it would be just as easy to do it manually, since only four columns per row would not allow the Excel random function to give truly random results. It would be susceptible to repetitive output because of limited seed values.

Only problem with that is, it is over 10,000 records that would need to be randomly changed.

 

[Rick Rothstein]

Each row's rearrangement is independent of each other, correct? By that I mean a column can have repeats... it is one the rows that you wan not repeated, correct? If so, put the following in module and then run the RandomizeOffices macro...

Sub RandomizeOffices()
  Dim R As Long, RowData As Variant
  For R = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    RowData = Application.Index(Cells(R, "B").Resize(, 4).Value, 1, 0)
    RandomizeArray RowData
    Cells(R, "B").Resize(, 4) = RowData
  Next
End Sub

Sub RandomizeArray(ArrayIn As Variant)
  Dim Cnt As Long, RandomIndex As Long, Tmp As Variant
  If VarType(ArrayIn) >= vbArray Then
    For Cnt = UBound(ArrayIn) To 1 Step -1
      RandomIndex = Int(Cnt * Rnd + 1)
      Tmp = ArrayIn(RandomIndex)
      ArrayIn(RandomIndex) = ArrayIn(Cnt)
      ArrayIn(Cnt) = Tmp
    Next
  End If
End Sub

 

[Max1616]

Try this!

Sub JJS11()
Dim Val1, Val2, Val3, Val4 As Integer
Dim i1, i2, i3 As Long
Dim lrow As Long
Dim Cnt1, Cnt2, Cnt3, Cnt4 As Integer

lrow = Cells(Rows.Count, 1).End(xlUp).Row

For i1 = 2 To lrow
    Val1 = Cells(i1, 2)
    Val2 = Cells(i1, 3)
    Val3 = Cells(i1, 4)
    Val4 = Cells(i1, 5)

    Range(Cells(i1, 2), Cells(i1, 5)).ClearContents
    Cnt1 = WorksheetFunction.RandBetween(2, 5)
    Cells(i1, Cnt1) = Val1
Cnt2Num:
    Cnt2 = WorksheetFunction.RandBetween(2, 5)
    If Cnt2 = Cnt1 Then GoTo Cnt2Num
    Cells(i1, Cnt2) = Val2

Cnt3Num:
    Cnt3 = WorksheetFunction.RandBetween(2, 5)
    If Cnt3 = Cnt1 Or Cnt3 = Cnt2 Then GoTo Cnt3Num
    Cells(i1, Cnt3) = Val3
Cnt4Num:
    Cnt4 = WorksheetFunction.RandBetween(2, 5)
    If Cnt4 = Cnt1 Or Cnt4 = Cnt2 Or Cnt4 = Cnt3 Then GoTo Cnt4Num
    Cells(i1, Cnt4) = Val4
    
Next i1

End Sub

Sincerely,
Max

 

[Rick Rothstein]

Each row's rearrangement is independent of each other, correct? By that I mean a column can have repeats... it is one the rows that you wan not repeated, correct? If so, put the following in module and then run the RandomizeOffices macro...

Sub RandomizeOffices()
  Dim R As Long, RowData As Variant
[B][COLOR="#FF0000"]  Static IsRandomized As Boolean
  If Not IsRandomized Then
    Randomize
    IsRandomized = True
  End If[/COLOR][/B]
  For R = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    RowData = Application.Index(Cells(R, "B").Resize(, 4).Value, 1, 0)
    RandomizeArray RowData
    Cells(R, "B").Resize(, 4) = RowData
  Next
End Sub

Sub RandomizeArray(ArrayIn As Variant)
  Dim Cnt As Long, RandomIndex As Long, Tmp As Variant
  If VarType(ArrayIn) >= vbArray Then
    For Cnt = UBound(ArrayIn) To 1 Step -1
      RandomIndex = Int(Cnt * Rnd + 1)
      Tmp = ArrayIn(RandomIndex)
      ArrayIn(RandomIndex) = ArrayIn(Cnt)
      ArrayIn(Cnt) = Tmp
    Next
  End If
End Sub

Whoops... I forgot the Randomize statement (see the part in red above).

 

[JJS11]

Each row's rearrangement is independent of each other, correct? By that I mean a column can have repeats... it is one the rows that you wan not repeated, correct? If so, put the following in module and then run the RandomizeOffices macro...

[COLOR=#333333][I]Sub RandomizeOffices()[/I][/COLOR]  Dim R As Long, RowData As Variant
[B][COLOR=#FF0000]  Static IsRandomized As Boolean
  If Not IsRandomized Then
    Randomize
    IsRandomized = True
  End If[/COLOR][/B]
  For R = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    RowData = Application.Index(Cells(R, "B").Resize(, 4).Value, 1, 0)
    RandomizeArray RowData
    Cells(R, "B").Resize(, 4) = RowData
  Next
End Sub

Sub RandomizeArray(ArrayIn As Variant)
  Dim Cnt As Long, RandomIndex As Long, Tmp As Variant
  If VarType(ArrayIn) >= vbArray Then
    For Cnt = UBound(ArrayIn) To 1 Step -1
      RandomIndex = Int(Cnt * Rnd + 1)
      Tmp = ArrayIn(RandomIndex)
      ArrayIn(RandomIndex) = ArrayIn(Cnt)
      ArrayIn(Cnt) = Tmp
    Next
  End If
End Sub

This works perfectly! Thank you. I did not try any other suggestion because of the simplicity of this code. Thank you so much!

Now I just need to try and figure out what is going on in each line of code....

 

[Rick Rothstein]

Now I just need to try and figure out what is going on in each line of code....

Basically, the RandomizeArray subroutine takes a one-dimensional array (the Application.Index function call in the RandomizeOffices macro returns a one-dimensional from a contiguous row of cells) and randomizes its elements by swapping a randomly selected element from the first Cnt number of elements in the array with the Cnt'th array element... because the Cnt value decrements by one, that swapped element will not be touched again for the rest of the loop. In this way, the elements of the array get randomly scrambled one-at-a-time guaranteeing that there will be no repeats.

 

[JJS11]

Basically, the RandomizeArray subroutine takes a one-dimensional array (the Application.Index function call in the RandomizeOffices macro returns a one-dimensional from a contiguous row of cells) and randomizes its elements by swapping a randomly selected element from the first Cnt number of elements in the array with the Cnt'th array element... because the Cnt value decrements by one, that swapped element will not be touched again for the rest of the loop. In this way, the elements of the array get randomly scrambled one-at-a-time guaranteeing that there will be no repeats.

You are truly amazing. I appreciate all your help and the quick responses. Thank you, sir!