VBA or Formula to populate range of cells with set frequency of pre-defined values.

[bartmaster]

Hello,

Please see below table:

Book2
	A	B	C	D	E	F	G
1	Values		Value	Occurrence		New count of values:	65
2	BBB		AAA	10%
3	AAA		AAB	5%			Values:
4	AAB		ABA	15%
5	ABA		ABB	15%
6	AAA		BAA	15%
7	ABB		BAB	15%
8	BAB		BBA	15%
9	BBA		BBB	10%
10	BBB
11	ABA
12	BAB
13	BAA
14	BBA
15	ABB
16	BAA
17	BBA
18	ABA
19	ABB
20	BAB
21	BAA
Sheet1

Cell Formulas
Range	Formula
D2:D9	D2	=COUNTIF($A$2:$A$21,C2)/20

Column C contains a list of distinct values from column A with their percentage distribution in column D.
Easy enough!

The question is how can we revert the process to get a list of pre-defined valuesfrom column C into column G (starting from row 4).
I would want to have them in random order but keeping the set distribution percentage?
Additionally a variable in the cell G1 would tell how many rows we would like to fill, i.e. currently column A has 20 values but in column F we would like to get a list of 65 values.

Any ideas?
Many thanks

 

[bartmaster]

bump...
Any ideas anyone?

 

[bartmaster]

bump...
Any help would be greatly appreciated...

 

[Peter_SSs]

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

 

[bartmaster]

@Peter_SSs
Many thanks for pointing this out.
I've updated my profile info and saved.
I would appreciate some help on this thread, if anything is not clear or any more information is required please let me know.

 

[Peter_SSs]

I've updated my profile info and saved.

Thanks for that.

Could you use something like this?
Note that it is not an exact science (see particularly the green cells) since when splitting the new count into the given percentages, some rounding will most likely need to be done since you cannot have two and a half rows of AAA.

You would have to use your 365 version for this method.

bartmaster_1.xlsm
	A	B	C	D	E	F	G
1	Values		Value	Occurrence	New Occurrence	New count of values:	34
2	BBB		AAA	10%	4
3	AAA		AAB	5%	2		Values:
4	AAB		ABA	15%	5		BAB
5	ABA		ABB	15%	5		BBA
6	AAA		BAA	15%	5		AAA
7	ABB		BAB	15%	5		AAB
8	BAB		BBA	15%	5		ABA
9	BBA		BBB	10%	3		ABA
10	BBB						BBB
11	ABA						ABA
12	BAB						BAB
13	BAA						ABB
14	BBA						AAA
15	ABB						ABB
16	BAA						BAB
17	BBA						BBA
18	ABA						BBB
19	ABB						ABB
20	BAB						BAA
21	BAA						ABA
22							ABB
23							BAA
24							BBA
25							BAA
26							AAB
27							AAA
28							BBA
29							AAA
30							ABA
31							BAB
32							BAA
33							BAB
34							BBB
35							BAA
36							ABB
37							BBA
38
Set % List

Cell Formulas
Range	Formula
G4:G37	G4	=SORTBY(FILTERXML(SUBSTITUTE(SUBSTITUTE(TEXTJOIN("</c><c>",,REPT("</c><c>"&C2:C9,E2:E9)),"</c><c></c><c>","</c><c>"),"</c>","<p>",1)&"</c></p>","//c"),RANDARRAY(G1))
D2:D9	D2	=COUNTIF($A$2:$A$21,C2)/20
E2	E2	=G1-SUM(E3:E21)
E3:E21	E3	=IF(D3="","",ROUND(G$1*D3,0))
Dynamic array formulas.

 

[bartmaster]

@Peter_SSs
Thank you very much for this. It works as expected. ?

Before I actually mark your reply as solution I am wondering if there are any VBA alternatives so this would also work on an earlier Excel version (not 365)?

Many thanks again!
Much appreciated

 

[Peter_SSs]

I am wondering if there are any VBA alternatives

Try this with a copy of your workbook.

Sub New_List()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, Tsum As Long, NewCount As Long
  
  Randomize
  a = Range("C2", Range("D" & Rows.Count).End(xlUp)).Value
  NewCount = Range("G1").Value
  For i = 2 To UBound(a)
    a(i, 2) = Round(a(i, 2) * NewCount, 0)
    Tsum = Tsum + a(i, 2)
  Next i
  a(1, 2) = NewCount - Tsum
  ReDim b(1 To NewCount, 1 To 2)
  For i = 1 To UBound(a)
    For j = 1 To a(i, 2)
      k = k + 1
      b(k, 1) = a(i, 1)
      b(k, 2) = Rnd
    Next j
  Next i
  Application.ScreenUpdating = False
  With Range("G4:H4").Resize(NewCount)
    .Value = b
    .Sort Key1:=.Columns(2), Header:=xlNo
    .Columns(2).ClearContents
  End With
  Application.ScreenUpdating = True
End Sub

 

[bartmaster]

@Peter_SSs
Amazing! Many thanks, your help is much appreciated!

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.