Numbers from average

[giovyledzep]

Hello everybody,

Is there a way in Excel to generate a list of numbers from an average value?

What I mean is for example, if I have a cell with the number 100, can I generate a list of numbers that average 100?
Of course telling Excel how long the list should be and what numbers are acceptable (for example I only want 25, 100, 200 to appear)

Any ideas?
Thanks

 

[Jeffrey Mahoney]

Talking this one out without a clear solution.

Seems to me you might want to provide a range of values within the set, either by a percentage + or - of the average or by a value. As you stated, the number of numbers in the list.

A macro is in order. It could start by throwing out random numbers + and - until it reaches 90% of the number of items, then it would have to start evaluating how to correct the average and restrict the remaining numbers.

Jeff

 

[Jeffrey Mahoney]

This is a pretty good random selection of values

Book3 20240221.xlsm
	B	C	D	E	F	G	H
1					100	200
2					List		Percent
3					127	1	0.50%
4	Average:	100			273	2	1.00%
5	Number of Items:	200			153	3	1.50%
6	Swing:	300			4	4	2.00%
7					-172	5	2.50%
8					31	6	3.00%
9					234	7	3.50%
10					175	8	4.00%
11					-78	9	4.50%
12					389	10	5.00%
13					369	11	5.50%
14					119	12	6.00%
15					-188	13	6.50%
16					-143	14	7.00%
17					363	15	7.50%
18					-129	16	8.00%
19					-110	17	8.50%
20					-184	18	9.00%
21					69	19	9.50%
22					-84	20	10.00%
23					304	21	10.50%
24					-25	22	11.00%
25					160	23	11.50%
26					273	24	12.00%
27					-129	25	12.50%
28					206	26	13.00%
29					365	27	13.50%
30					176	28	14.00%
31					268	29	14.50%
32					324	30	15.00%
33					-42	31	15.50%
34					-139	32	16.00%
35					250	33	16.50%
36					197	34	17.00%
37					265	35	17.50%
38					375	36	18.00%
39					303	37	18.50%
40					129	38	19.00%
41					172	39	19.50%
42					44	40	20.00%
43					23	41	20.50%
44					332	42	21.00%
45					-167	43	21.50%
46					-73	44	22.00%
47					-109	45	22.50%
48					124	46	23.00%
49					-167	47	23.50%
50					170	48	24.00%
51					231	49	24.50%
52					58	50	25.00%
53					233	51	25.50%
54					-149	52	26.00%
55					83	53	26.50%
56					-5	54	27.00%
57					225	55	27.50%
58					-177	56	28.00%
59					59	57	28.50%
60					156	58	29.00%
61					138	59	29.50%
62					93	60	30.00%
63					34	61	30.50%
64					137	62	31.00%
65					362	63	31.50%
66					19	64	32.00%
67					157	65	32.50%
68					125	66	33.00%
69					233	67	33.50%
70					151	68	34.00%
71					321	69	34.50%
72					-98	70	35.00%
73					375	71	35.50%
74					72	72	36.00%
75					-95	73	36.50%
76					280	74	37.00%
77					154	75	37.50%
78					-90	76	38.00%
79					37	77	38.50%
80					91	78	39.00%
81					90	79	39.50%
82					-9	80	40.00%
83					-181	81	40.50%
84					226	82	41.00%
85					189	83	41.50%
86					269	84	42.00%
87					359	85	42.50%
88					75	86	43.00%
89					-131	87	43.50%
90					-53	88	44.00%
91					-65	89	44.50%
92					238	90	45.00%
93					29	91	45.50%
94					-164	92	46.00%
95					76	93	46.50%
96					345	94	47.00%
97					148	95	47.50%
98					-173	96	48.00%
99					99	97	48.50%
100					-147	98	49.00%
101					133	99	49.50%
102					360	100	50.00%
103					330	101	50.50%
104					-158	102	51.00%
105					357	103	51.50%
106					-132	104	52.00%
107					53	105	52.50%
108					48	106	53.00%
109					-12	107	53.50%
110					365	108	54.00%
111					227	109	54.50%
112					382	110	55.00%
113					261	111	55.50%
114					76	112	56.00%
115					95	113	56.50%
116					-20	114	57.00%
117					371	115	57.50%
118					-75	116	58.00%
119					279	117	58.50%
120					9	118	59.00%
121					263	119	59.50%
122					211	120	60.00%
123					216	121	60.50%
124					168	122	61.00%
125					-193	123	61.50%
126					-197	124	62.00%
127					49	125	62.50%
128					170	126	63.00%
129					58	127	63.50%
130					123	128	64.00%
131					-198	129	64.50%
132					132	130	65.00%
133					242	131	65.50%
134					189	132	66.00%
135					19	133	66.50%
136					321	134	67.00%
137					317	135	67.50%
138					-194	136	68.00%
139					87	137	68.50%
140					-168	138	69.00%
141					229	139	69.50%
142					391	140	70.00%
143					-135	141	70.50%
144					58	142	71.00%
145					87	143	71.50%
146					39	144	72.00%
147					-40	145	72.50%
148					44	146	73.00%
149					387	147	73.50%
150					110	148	74.00%
151					231	149	74.50%
152					200	150	75.00%
153					142	151	75.50%
154					-195	152	76.00%
155					-186	153	76.50%
156					390	154	77.00%
157					32	155	77.50%
158					-48	156	78.00%
159					224	157	78.50%
160					267	158	79.00%
161					22	159	79.50%
162					332	160	80.00%
163					82	161	80.50%
164					-16	162	81.00%
165					139	163	81.50%
166					247	164	82.00%
167					241	165	82.50%
168					113	166	83.00%
169					6	167	83.50%
170					46	168	84.00%
171					-29	169	84.50%
172					19	170	85.00%
173					-166	171	85.50%
174					6	172	86.00%
175					388	173	86.50%
176					305	174	87.00%
177					204	175	87.50%
178					-57	176	88.00%
179					293	177	88.50%
180					215	178	89.00%
181					-99	179	89.50%
182					111	180	90.00%
183					107	181	90.50%
184					-16	182	91.00%
185					-101	183	91.50%
186					301	184	92.00%
187					269	185	92.50%
188					84	186	93.00%
189					-174	187	93.50%
190					-178	188	94.00%
191					286	189	94.50%
192					94	190	95.00%
193					-181	191	95.50%
194					143	192	96.00%
195					63	193	96.50%
196					214	194	97.00%
197					193	195	97.50%
198					-145	196	98.00%
199					303	197	98.50%
200					277	198	99.00%
201					43	199	99.50%
202					-32	200	100.00%
Sheet1

Cell Formulas
Range	Formula
F1	F1	=AVERAGE(F3:F1579)
G1	G1	=COUNT(F3:F409)
H3:H202	H3	=G3/ItemNum

Named Ranges
Name	Refers To	Cells
ItemNum	=Sheet1!$C$5	H3:H202

Sub RandomizeAverage()
  Dim Cel As Range
  Dim Rng As Range
  Dim AvgNum As Long
  Dim ItemNum As Long
  Dim Swing As Long
  Dim LSwing As Long
  Dim HSwing As Long
  Dim LstHdr As Range
  Dim X As Long
  Dim Avg As Double
  Dim RemItms As Long
  Dim Dif As Long
  Dim LowSwing As Long
  Dim HighSwing As Long
  Dim TempSwing As Long
  Dim Sum As Long
  
  Set LstHdr = Range("F2")
  AvgNum = Range("AvgNum").Value
  ItemNum = Range("ItemNum").Value
  Swing = Range("Swing").Value
  LSwing = AvgNum - Swing
  HSwing = AvgNum + Swing
  
  Set Rng = Range(LstHdr.Offset(1, 0), LstHdr.End(xlDown))
  Rng.ClearContents
  
  For X = 1 To ItemNum
    CurPerc = X / ItemNum
    If X < ItemNum Then               'And CurPerc - LastPerc >= 0.01 Then
      Set Rng = Range(LstHdr.Offset(1, 0), LstHdr.End(xlDown))
      Sum = Application.Sum(Rng)
      Dif = (ItemNum * AvgNum) - Sum
      TempSwing = Dif / (ItemNum - X)
      
      If TempSwing - AvgNum < 0 Then
        LowSwing = LSwing
        HighSwing = HSwing - Abs(TempSwing - AvgNum) * 4
      ElseIf TempSwing - AvgNum > 0 Then
        LowSwing = LSwing + Abs(TempSwing - AvgNum) * 4
        HighSwing = HSwing
      End If
      LstHdr.Offset(X, 0).Value = Application.RandBetween(LowSwing, HighSwing)
        
    ElseIf X = ItemNum Then
      Set Rng = Range(LstHdr.Offset(1, 0), LstHdr.End(xlDown))
      Sum = Application.Sum(Rng)
      Dif = (ItemNum * AvgNum) - Sum
      LstHdr.Offset(X, 0).Value = Dif
    
    End If
    
  Next X
  
End Sub

 

[Jeffrey Mahoney]

ok, I fixed an error that was happening every tenth run

Sub RandomizeAverage()
  Dim Cel As Range
  Dim Rng As Range
  Dim AvgNum As Long
  Dim ItemNum As Long
  Dim Swing As Long
  Dim LSwing As Long
  Dim HSwing As Long
  Dim LstHdr As Range
  Dim X As Long
  Dim Avg As Double
  Dim RemItms As Long
  Dim Dif As Long
  Dim LowSwing As Long
  Dim HighSwing As Long
  Dim TempSwing As Long
  Dim Sum As Long
  
  Set LstHdr = Range("F2")
  AvgNum = Range("AvgNum").Value
  ItemNum = Range("ItemNum").Value
  Swing = Range("Swing").Value
  LSwing = AvgNum - Swing
  HSwing = AvgNum + Swing
  
  Set Rng = Range(LstHdr.Offset(1, 0), LstHdr.End(xlDown))
  Rng.ClearContents
  Application.Calculation = xlCalculationManual
  
  For X = 1 To ItemNum
    CurPerc = X / ItemNum
    If X < ItemNum Then               'And CurPerc - LastPerc >= 0.01 Then
      Set Rng = Range(LstHdr.Offset(1, 0), LstHdr.End(xlDown))
      Sum = Application.Sum(Rng)
      Dif = (ItemNum * AvgNum) - Sum
      TempSwing = Dif / (ItemNum - X)
      
      If TempSwing - AvgNum < 0 Then
        LowSwing = LSwing
        HighSwing = HSwing - Abs(TempSwing - AvgNum) * 4
        If HighSwing < LowSwing Then HighSwing = LowSwing + 10
      ElseIf TempSwing - AvgNum > 0 Then
        LowSwing = LSwing + Abs(TempSwing - AvgNum) * 4
        HighSwing = HSwing
        If LowSwing > HighSwing Then LowSwing = HighSwing - 10
      End If
      LstHdr.Offset(X, 0).Value = Application.RandBetween(LowSwing, HighSwing)
              
    ElseIf X = ItemNum Then
      Set Rng = Range(LstHdr.Offset(1, 0), LstHdr.End(xlDown))
      Sum = Application.Sum(Rng)
      Dif = (ItemNum * AvgNum) - Sum
      LstHdr.Offset(X, 0).Value = Dif
    
    End If
    
  Next X
  
  Application.Calculation = xlCalculationAutomatic

End Sub

 

[kevin9999]

Another option...

Option Explicit
Sub GetNumbersToAverage()
    Dim MyTarget As Long, NumberN As Long, i As Long, j As Long
    MyTarget = Range("B1")
    NumberN = Range("B2")
    j = WorksheetFunction.RoundDown(NumberN / 2, 1)
    Range("B4", Cells(Rows.Count, "B").End(xlUp)).ClearContents
    If WorksheetFunction.IsOdd(NumberN) Then
        Cells(4, 2) = MyTarget
        i = 5
    Else
        i = 4
    End If
    With Cells(i, 2).Resize(j)
        .Formula = "=randbetween(1," & MyTarget & ")"
        .Value = .Value
    End With
    With Cells(i + j, 2).Resize(j)
        .FormulaR1C1 = "=" & MyTarget & "+(" & MyTarget & "-R[-" & j & "]C)"
        .Value = .Value
    End With
End Sub

Example 1:

Book1
	A	B	C	D	E
1	Given number:	100
2	Number of numbers:	25
3
4	List:	100		100	=Average
5		17
6		16
7		90
8		71
9		13
10		18
11		62
12		83
13		64
14		42
15		78
16		31
17		183
18		184
19		110
20		129
21		187
22		182
23		138
24		117
25		136
26		158
27		122
28		169
29
Sheet4

Cell Formulas
Range	Formula
D4	D4	=AVERAGE(B4:B59)

Example 2:

Book1
	A	B	C	D	E
1	Given number:	79
2	Number of numbers:	50
3
4	List:	13		79	=Average
5		4
6		9
7		45
8		50
9		72
10		9
11		14
12		2
13		9
14		52
15		31
16		46
17		56
18		45
19		59
20		51
21		74
22		46
23		35
24		43
25		76
26		56
27		73
28		30
29		145
30		154
31		149
32		113
33		108
34		86
35		149
36		144
37		156
38		149
39		106
40		127
41		112
42		102
43		113
44		99
45		107
46		84
47		112
48		123
49		115
50		82
51		102
52		85
53		128
54
Sheet4

Cell Formulas
Range	Formula
D4	D4	=AVERAGE(B4:B59)

 

[kevin9999]

Edited to accommodate the first time you run it:

Option Explicit
Sub GetNumbersToAverage()
    Dim MyTarget As Long, NumberN As Long, i As Long, j As Long
    MyTarget = Range("B1")
    NumberN = Range("B2")
    If MyTarget > 0 And NumberN > 0 Then
        j = WorksheetFunction.RoundDown(NumberN / 2, 1)
        Range("B4:B" & Application.Max(Cells(Rows.Count, 2).End(xlUp).Row, 2)).ClearContents
        If WorksheetFunction.IsOdd(NumberN) Then
            Cells(4, 2) = MyTarget
            i = 5
        Else
            i = 4
        End If
        With Cells(i, 2).Resize(j)
            .Formula = "=randbetween(1," & MyTarget & ")"
            .Value = .Value
        End With
        With Cells(i + j, 2).Resize(j)
            .FormulaR1C1 = "=" & MyTarget & "+(" & MyTarget & "-R[-" & j & "]C)"
            .Value = .Value
        End With
    End If
End Sub