Randomize the Order of Terms in a Cell in Excel?

[Tharg0r]

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

 

[Gary's Student]

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

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

 

[MickG]

Try this:-

[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

 

[Tharg0r]

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!