Randomize the Order of Terms in a Cell in Excel?

Tharg0r

New Member
Joined
Sep 19, 2012
Messages
4
Hi, I have multiple duplicate entries in a column in excel, eg each cell contains: dog, cat, horse, pig, monkey, sheep, fish

There are multiple cells per column containing different terms but they are all seperated by commas and a space, I want to scramble them so each cell contains the same terms but sorted in a random order, so the example up there would become horse, sheep, monkey, cat, fish, dog etc, is this possible does anyone know?

Thanks
 
High-light the cells whose contents you want to scramble and run scramble:

Code:
Sub scramble()
Dim U As Integer, L As Integer, out As Variant
For Each r In Selection
    v = r.Value
    ary = Split(v, ",")
    U = UBound(ary)
    L = LBound(ary)
    ReDim aryy(1 To U + 1)
    For J = 1 To U + 1
        aryy(J) = ary(J - 1)
    Next
    out = RandomSampleArray(aryy, U + 1)
    ReDim Preserve out(1 To U + 1)
    v = Join(out, ",")
    r.Value = v
Next
End Sub

Function RandomSampleArray(InArray As Variant, n As Long) As Variant
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Rick Rothstein
'
'http://answers.microsoft.com/en-us/office/forum/office_2007-customize/return-a-subset-of-an-array/5dd1fd36-3590-4811-afd9-59efdad70665
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Cnt As Long, RandomIndex As Long, Temp As Variant, TempArray As Variant
Static IsRandomized As Variant
If IsEmpty(IsRandomized) Then
     Randomize
     IsRandomized = True
End If
TempArray = InArray
For Cnt = UBound(TempArray) To LBound(TempArray) Step -1
     RandomIndex = Int((Cnt - LBound(TempArray) + 1) * Rnd + LBound(TempArray))
     Temp = TempArray(RandomIndex)
     TempArray(RandomIndex) = TempArray(Cnt)
     TempArray(Cnt) = Temp
Next
ReDim Preserve TempArray(1 To n)
RandomSampleArray = TempArray
End Function
 
Upvote 0
Try this:-

Code:
[COLOR="Navy"]Sub[/COLOR] MG19Sep56
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ray
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] nRdn        [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
c = 0
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
  Ray = application.Transpose(Split(Dn, ","))
  ReDim nRay(1 To UBound(Ray) + 1)
                Randomize
    [COLOR="Navy"]Do[/COLOR] Until c = UBound(Ray)
        nRdn = Int(Rnd * UBound(Ray)) + 1
        [COLOR="Navy"]If[/COLOR] Not Ray(nRdn, 1) = vbNullString [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            nRay(c) = Ray(nRdn, 1)
            
            Ray(nRdn, 1) = vbNullString
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Loop[/COLOR]
c = 0
Dn = Left(Join(nRay, ","), Len(Join(nRay, ",")) - 1)
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Excellent thanks, both work perfectly, both give an error if they try to work on a blank cell funnily enough but thats easily worked around, thanks a million for this you have no idea how much work it saves me!
 
Upvote 0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top