Shuffle words to appear to be random

funguy

New Member
Joined
Feb 7, 2012
Messages
24
Shuffle words to appear to be random

Hi , I'm trying to make some data look a little more 'human' by shuffling around some words/phrases. Each cell will always contain 4 words/phrases. I'd like to shuffle them to make them look random. The comma needs to be the deliminator because sometimes the term might be a 2 or 3 words phrase or term (like 'dark forest green' for example). I figure the easiest way is to split each word/phrase into it's own column/cell, then reconstruct them using a varied formula to create the shuffle effect ? I'm very open to trying a macro if some genius out there knows one. I use macros but cannot write them, so figured I'd try a formula approach first. I could not attach a sample worksheet, so I added it to a wetransfer link, and also a quick example below. Any ideas would be much appreciated.

- THANK YOU

example file
https://we.tl/4ta1kJKDOt


Column A (given data): --- Column B (desired results):
red, blue, green, yellow --- blue, red, yellow, green
red, blue, green, yellow --- green, blue, red, yellow
red, blue, green, yellow --- red, yellow, green, blue
red, blue, green, yellow --- yellow, green, red, blue
 
Last edited:

Some videos you may like

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

WarPigl3t

Well-known Member
Joined
May 25, 2014
Messages
1,599
I think the easiest way is with a macro. The macro logic will read as follows. The first row with your color data will be in row 2 because maybe you have headers. Change it to row 1 if you don't. For each row in column A all the way down to the last row, split the data into an array using a comma as the delimiter. Once split, send the split array to a function which shuffles the array and returns the new array to the original macro subroutine. Combine each element in the array into one string value separated by commas. Output the string into column B. Do this for all rows.
Code:
Sub myMacro()
     firstRow = 2
     lastRow = Range("A" & Rows.Count).End(xlUp).Row
     r = firstRow
     Do Until r > lastRow
          valueA = Range("A" & r).Value
          splitA = Split(valueA, ", ")
          newArray = ShuffleArray(splitA)
          valueB = ""
          For Each element In newArray
               valueB = valueB & ", " & element
          Next element
          valueB = Right(valueB, Len(valueB) - 2)
          Range("B" & r).Value = valueB
          r = r + 1
     Loop
End Sub
Pulled this shuffle array code from http://www.cpearson.com/excel/ShuffleArray.aspx
Code:
Function ShuffleArray(InArray() As Variant) As Variant()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ShuffleArray
' This function returns the values of InArray in random order. The original
' InArray is not modified.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim N As Long
    Dim Temp As Variant
    Dim J As Long
    Dim Arr() As Variant
    
    
    Randomize
    L = UBound(InArray) - LBound(InArray) + 1
    ReDim Arr(LBound(InArray) To UBound(InArray))
    For N = LBound(InArray) To UBound(InArray)
        Arr(N) = InArray(N)
    Next N
    For N = LBound(InArray) To UBound(InArray)
        J = CLng(((UBound(InArray) - N) * Rnd) + N)
        Temp = Arr(N)
        Arr(N) = ARr(J)
        Arr(J) = Temp
    Next N
    ShuffleArray = Arr
End Function
 
Last edited:

Trebor76

Well-known Member
Joined
Jul 23, 2007
Messages
4,601
Hi there,

My results are different as by nature they're random but I think this is what you're after:

Code:
Option Explicit
Sub Macro1()

    Dim rngMyCell As Range
    Dim strTextArray() As String
    Dim i As Integer
    Dim dblMyNum As Double
    Dim clnMyNumbers As New Collection
    Dim strMyShuffledText As String
    
    Application.ScreenUpdating = False
    
    For Each rngMyCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row) 'Range A2:A [last row]
        strTextArray() = Split(rngMyCell, ",")
        Randomize
        Do Until i = 4 'Randomize numbers 1 to 4 inclusive
            dblMyNum = Int((4 - 1 + 1) * Rnd + 1) 'http://www.techonthenet.com/excel/formulas/rnd.php
            On Error Resume Next
                clnMyNumbers.Add Item:=dblMyNum, Key:=CStr(dblMyNum)
                If Err.Number = 0 Then
                    If strMyShuffledText = "" Then
                        strMyShuffledText = Trim(strTextArray(dblMyNum - 1))
                    Else
                        strMyShuffledText = strMyShuffledText & ", " & Trim(strTextArray(dblMyNum - 1))
                    End If
                    i = i + 1
                Else
                    Err.Clear
                End If
            On Error GoTo 0
        Loop
        'Output shuffled text
        rngMyCell.Offset(0, 1) = strMyShuffledText
        'Initialise variables
        i = 0
        Set clnMyNumbers = Nothing
        strMyShuffledText = ""
    Next rngMyCell
    
    Application.ScreenUpdating = False

End Sub
Regards,

Robert
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
44,758
Office Version
365
Platform
Windows
If you want to try another one, here's a shorter one that I think also does what you want.

Rich (BB code):
Sub ShufflePhrases()
  Dim a As Variant, b As Variant, phrases As Variant
  Dim i As Long, j As Long, k As Long
  
  Randomize
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    phrases = Split(a(i, 1), ", ")
    For j = 0 To UBound(phrases)
      k = Int(Rnd() * (UBound(phrases) - j))
      b(i, 1) = b(i, 1) & ", " & phrases(k)
      phrases(k) = phrases(UBound(phrases) - j)
    Next j
    b(i, 1) = Mid(b(i, 1), 3)
  Next i
  Range("B2").Resize(UBound(b)).Value = b
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,099,970
Messages
5,471,765
Members
406,781
Latest member
aproberts1980

This Week's Hot Topics

Top