Randomise a List but spread results out so they don't appear near or straight after itself

[Dazzybeeguy]

I have a list in A1:A213 that contains 14 distinct values.
I am using =SORTBY(A1:A213,RANDARRAY(COUNTA(A1:A213))) to randomise that list which it does.

L

M

R

SWM

LM

LMS

EAM

SNM

H

W

WS

LMN

MH

IO

My issue is that I want an even spread, I get the same value next to or very near to itself and was hoping there was something I could do to mitigate or eradicate this.

Column A Full List Column B with =SORTBY(A1:A200,RANDARRAY(COUNTA(A1:A213)))

L	SWM
M	H
M	WS
R	H
SWM	R
LM	M
LMS	H
EAM	SNM
M	H
LM	LM
SNM	SWM
LMS	R
SWM	R
R	M
H	LMN
EAM	W
W	LM
WS	M
LMS	W
M	H
W	H
H	H
SWM	IO
WS	EAM
SNM	LMN
M	R
H	H
WS	W
SWM	R
SWM	H
LMN	IO
H	EAM
SNM	R
H	M
LMS	LMN
R	H
H	M
R	LM
H	EAM
MH	R
H	H
R	H
M	M
W	H
M	H
M	H
H	WS
EAM	LMN
H	LM
LMN	W
SWM	M
M	H
MH	R
M	M
W	WS
LMN	LMS
H	LM
SNM	R
R	EAM
LMN	SWM
WS	R
SNM	EAM
H	H
SWM	MH
H	M
M	EAM
LMN	MH
H	H
LMS	H
W	H
WS	LMN
LMN	R
LMS	LMS
EAM	M
M	SWM
R	H
LMS	R
LMN	M
SWM	H
H	H
M	M
W	M
MH	M
LM	EAM
WS	EAM
H	M
M	WS
H	MH
R	SWM
EAM	M
LMN	M
H	SWM
R	H
WS	L
SNM	H
SWM	EAM
SWM	SNM
R	M
H	SWM
W	LMS
EAM	R
SWM	EAM
EAM	SNM
MH	R
SNM	M
SNM	LMS
LM	EAM
LMN	M
R	M
H	LMN
MH	LM
IO	M
H	LMN
LMS	H
EAM	W
R	W
H	LMS
R	MH
H	LM
W	LMS
R	W
LMS	M
LMS	M
R	H
H	SWM
EAM	SNM
W	EAM
M	LMS
H	M
W	LMN
H	LMS
SNM	H
H	LMS
R	MH
R	M
M	WS
LMN	R
M	SNM
R	H
M	SNM
M	WS
EAM	MH
LMS	R
SNM	LM
R	SNM
W	EAM
MH	W
WS	W
SNM	H
M	H
M	SNM
H	WS
WS	WS
H	EAM
WS	M
EAM	SWM
M	LMN
WS	SNM
H	H
H	H
M	M
LM	M
SNM	LM
H	IO
LMS	H
H	LMS
IO	SNM
LM	H
R	R
IO	W
EAM	H
H	LM
LMN	EAM
EAM	WS
MH	LMS
LM	R
M	LM
M	M
EAM	LM
H	H
LM	LMN
M	R
H	H
W	H
LM	LMN
LM	SNM
H	MH
SNM	R
LMN	WS
MH	H
LM	M
M	M
LMS	R
MH	WS
H	SNM
EAM	SWM
LMN	LMS
H	LMS
LM	SWM
M	R
WS	W
LMS	M
M	LMS
H	SWM
LMS	MH
M	H
SWM	LMS
M	WS
H	LMN
R	LMN
M	W
R	MH
M	SNM

 

[Kaper]

And in your output: do you want the same number of repetitions of single values, so if in column A you have

L	just once
M	33 times
R	22 times

and so on?

the same number of each single entry shall be in column B?

If so, I suspect its not possible or very complicated with formulas. while with VBA it can be probably achieved quite easily.

So: is VBA solution acceptable?


And:

H

H

is obviously unwanted situation.
How about

EAM	W
W	LM

or

H	LMS
IO	SNM
LM	H

 

[HighAndWilder]

I have a list in A1:A213 that contains 14 distinct values.
I am using =SORTBY(A1:A213,RANDARRAY(COUNTA(A1:A213))) to randomise that list which it does.

L

M

R

SWM

LM

LMS

EAM

SNM

H

W

WS

LMN

MH

IO

My issue is that I want an even spread, I get the same value next to or very near to itself and was hoping there was something I could do to mitigate or eradicate this.

Column A Full List Column B with =SORTBY(A1:A200,RANDARRAY(COUNTA(A1:A213)))

L	SWM
M	H
M	WS
R	H
SWM	R
LM	M
LMS	H
EAM	SNM
M	H
LM	LM
SNM	SWM
LMS	R
SWM	R
R	M
H	LMN
EAM	W
W	LM
WS	M
LMS	W
M	H
W	H
H	H
SWM	IO
WS	EAM
SNM	LMN
M	R
H	H
WS	W
SWM	R
SWM	H
LMN	IO
H	EAM
SNM	R
H	M
LMS	LMN
R	H
H	M
R	LM
H	EAM
MH	R
H	H
R	H
M	M
W	H
M	H
M	H
H	WS
EAM	LMN
H	LM
LMN	W
SWM	M
M	H
MH	R
M	M
W	WS
LMN	LMS
H	LM
SNM	R
R	EAM
LMN	SWM
WS	R
SNM	EAM
H	H
SWM	MH
H	M
M	EAM
LMN	MH
H	H
LMS	H
W	H
WS	LMN
LMN	R
LMS	LMS
EAM	M
M	SWM
R	H
LMS	R
LMN	M
SWM	H
H	H
M	M
W	M
MH	M
LM	EAM
WS	EAM
H	M
M	WS
H	MH
R	SWM
EAM	M
LMN	M
H	SWM
R	H
WS	L
SNM	H
SWM	EAM
SWM	SNM
R	M
H	SWM
W	LMS
EAM	R
SWM	EAM
EAM	SNM
MH	R
SNM	M
SNM	LMS
LM	EAM
LMN	M
R	M
H	LMN
MH	LM
IO	M
H	LMN
LMS	H
EAM	W
R	W
H	LMS
R	MH
H	LM
W	LMS
R	W
LMS	M
LMS	M
R	H
H	SWM
EAM	SNM
W	EAM
M	LMS
H	M
W	LMN
H	LMS
SNM	H
H	LMS
R	MH
R	M
M	WS
LMN	R
M	SNM
R	H
M	SNM
M	WS
EAM	MH
LMS	R
SNM	LM
R	SNM
W	EAM
MH	W
WS	W
SNM	H
M	H
M	SNM
H	WS
WS	WS
H	EAM
WS	M
EAM	SWM
M	LMN
WS	SNM
H	H
H	H
M	M
LM	M
SNM	LM
H	IO
LMS	H
H	LMS
IO	SNM
LM	H
R	R
IO	W
EAM	H
H	LM
LMN	EAM
EAM	WS
MH	LMS
LM	R
M	LM
M	M
EAM	LM
H	H
LM	LMN
M	R
H	H
W	H
LM	LMN
LM	SNM
H	MH
SNM	R
LMN	WS
MH	H
LM	M
M	M
LMS	R
MH	WS
H	SNM
EAM	SWM
LMN	LMS
H	LMS
LM	SWM
M	R
WS	W
LMS	M
M	LMS
H	SWM
LMS	MH
M	H
SWM	LMS
M	WS
H	LMN
R	LMN
M	W
R	MH
M	SNM

Does this give you want you need?

Set the variables up in the Main procedure to call the subRandomList procedure.

Randomise a List.xlsm
	A	B	C
1	L	WS
2	M	R
3	R	LMN
4	SWM	R
5	LM	IO
6	LMS	L
7	EAM	LMN
8	SNM	LMS
9	H	EAM
10	W	M
11	WS	R
12	LMN	L
13	MH	WS
14	IO	SNM
15		SWM
16		EAM
17		WS
18		LMS
19		MH
20		WS
21		M
22		H
23		W
24		L
25		EAM
26		LMS
27		SWM
28		IO
29		LMN
30		W
31		LMS
32		WS
33		SWM
34		LM
35		EAM
36		IO
37		M
38		W
39		LM
40		M
41		R
42		M
43		EAM
44		IO
45		SNM
46		EAM
47		IO
48		SWM
49		LMS
50		SWM
51		SNM
52		M
53		SNM
54		IO
55		SNM
56		MH
57		W
58		EAM
59		W
60		L
61		WS
62		W
63		EAM
64		R
65		SWM
66		LM
67		WS
68		L
69		SNM
70		WS
71		LMN
72		LM
73		IO
74		LMN
75		W
76		MH
77		LMS
78		M
79		IO
80		LMN
81		W
82		LMS
83		L
84		R
85		SNM
86		LMS
87		M
88		SWM
89		W
90		LMN
91		EAM
92		R
93		MH
94		LMS
95		LM
96		WS
97		SWM
98		EAM
99		SWM
100		MH
101		H
102		LMS
103		MH
104		H
105		IO
106		SNM
107		LM
108		MH
109		SWM
110		R
111		LM
112		L
113		WS
114		LMN
115		SWM
116		W
117		LMS
118		LMN
119		WS
120		EAM
121		M
122		LMS
123		LM
124		W
125		LM
126		LMN
127		R
128		H
129		IO
130		SWM
131		IO
132		M
133		IO
134		H
135		MH
136		H
137		SWM
138		MH
139		M
140		EAM
141		WS
142		SWM
143		LMS
144		SNM
145		SWM
146		H
147		R
148		M
149		MH
150		M
151		W
152		MH
153		SWM
154		IO
155		LMN
156		EAM
157		WS
158		LMN
159		LMS
160		R
161		LM
162		LMS
163		R
164		H
165		M
166		R
167		W
168		SNM
169		R
170		IO
171		EAM
172		L
173		LMS
174		LM
175		WS
176		MH
177		LMN
178		R
179		M
180		L
181		R
182		LMS
183		R
184		IO
185		MH
186		H
187		WS
188		R
189		SWM
190		L
191		LMN
192		WS
193		LMN
194		LM
195		EAM
196		SNM
197		LMN
198		SNM
199		R
200		LMS
201		H
202		LM
203		SNM
204		LMS
205		H
206		L
207		SNM
208		R
209		IO
210		LMN
211		LMS
212		LMN
213		IO
214
Sheet1

Private Sub Main()

  ' Range("A1:A14") - List of values.
  ' 231 - Number of items in the results list.
  ' Range("B1") - Position on sheet of results list.

  Call subRandomList(Range("A1:A14"), 213, Range("B1"))

End Sub

Public Sub subRandomList(rng As Range, intSize As Integer, rngPosition As Range)
Dim i As Integer
Dim arr() As Variant
Dim arrResult() As String
Dim strString As String
Dim strLast As String
Dim intNumber As Integer
Dim s As String
Dim intRow As Integer

  arr = rng.Value
  
  strLast = arr(1, 1)
      
  For i = 1 To intSize + 1
  
    Do While True
      
      intNumber = Int((UBound(arr) - 1 + 1) * Rnd + 1)
      
      If strLast <> arr(intNumber, 1) Then
        strString = strString & arr(intNumber, 1) & ","
        Exit Do
      End If
            
    Loop
        
    strLast = arr(intNumber, 1)
      
  Next i
  
  arrResult = Split(Left(strString, Len(strString) - 1), ",")
      
  rngPosition.Resize(UBound(arrResult), 1).Value = Application.Transpose(arrResult)
    
End Sub