How to distribute a set of numbers proportionally across cells in a TABLE

[Phantom1]

Hello friends.

I have a distribution problem that i encounter all the time and need to speed up the process with formulas or vba. Any help is highly appreciated.

Lets say that we have 19 companies (A,B ,... S) that each one supply us with a number of a specific item. (All items are the same and the numbers given may vary)
After we code the items (so only us know from which company each item was received), we need to mix the items and return to the companies same number they gave us, for testing.

My problem is how to distribute automatically the items (integers) near to their ratios so can add up to their total not only in rows but in columns also
I use the round function and then correct the numbers manually , but that requires a lot of effort and time.

I have already read a similar question in the forum but the answer does not work in my case. "How to distribute a set number proportionally across cells and still keeping the total at set number" by Delta21

Some things to keep in mind of secondary importance are.
1. No company gets back for testing more than 10% of its own items
2. The maximum number of items someone gets back for testing from a company, appears at least twice so he cannot trace back the written code on an item to its original location.

I give a sample image of a finished problem.

Thanks in advance

 

[BSALV]

And your excel version is 2021 or 365 ?

 

[BSALV]

For 2021 and 365
Every item gets a number, for the moment no check fo the % returned to the original supplier, but that's not a big deal.

Sub Distribution()
     Dim b(), rand()
     Set lo = Sheets("blad1").ListObjects("Tbl_Suppliers")
     a = lo.DataBodyRange.Columns(2).Value
     som = Application.Sum(a)
     ReDim b(1 To UBound(a), 1 To 1)
     rand = Application.Transpose(WorksheetFunction.RandArray(som))
     For i = 1 To UBound(a)
          s = ""
          If a(i, 1) > 0 Then
               For j = ptr + 1 To ptr + a(i, 1)

                    s = s & ", " & Application.Match(WorksheetFunction.Small(rand, j), rand, 0)
               Next
          End If
          ptr = ptr + a(i, 1)
          If Len(s) > 0 Then b(i, 1) = "'" & Mid(s, 3)
     Next
     With lo.DataBodyRange.Columns(3)
          .Value = b
          .EntireColumn.AutoFit
     End With
End Sub

Map2
	A	B	C
1	Company	number	Kolom1
2	A	5	50, 4, 28, 54, 26
3	B	5	74, 34, 11, 73, 20
4	C	3	52, 33, 77
5	D	1	25
6	E	2	69, 55
7	F	5	58, 43, 78, 68, 1
8	G	2	76, 72
9	H	1	70
10	I	5	45, 23, 47, 49, 22
11	J	5	59, 71, 18, 12, 38
12	K	4	3, 37, 15, 6
13	L	4	21, 10, 57, 66
14	M	2	2, 61
15	N	3	60, 39, 19
16	O	1	24
17	P	2	63, 5
18	Q	1	51
19	R	4	65, 48, 14, 32
20	S	4	67, 53, 16, 64
21	T	3	17, 80, 56
22	U	3	8, 27, 75
23	V	1	31
24	W	3	62, 30, 42
25	X	5	13, 9, 41, 36, 40
26	Y	5	29, 79, 35, 44, 7
27	Z	1	46
Blad1

 

[Dermot]

This isn't clear
The maximum number of items someone gets back for testing from a company, appears at least twice so he cannot trace back the written code on an item to its original location
Can you please give an example?

 

[BSALV]

in attachment your 19 suppliers, difficult/impossible for max 10% own parts.
At the right handside, the distribution in detail
example file

 

[Dermot]

Try this, it applies the 10% maximum
File

 

[Phantom1]

This isn't clear
The maximum number of items someone gets back for testing from a company, appears at least twice so he cannot trace back the written code on an item to its original location
Can you please give an example?

Thank you for taking the time to work on my problem.
Lets say that Company D is the major company that provides us with most of the items. Everybody knows that and all can see the code we write on an item.
If we sent to a third company for testing 100 items from company D and 20 from other companies then they will find out that the max number of 100 items with the same code corresponds to the larger company D.
But if we gave the third company another code with 100 items they could not be sure for our codes.

 

[Phantom1]

Than

And your excel version is 2021 or 365 ?

Thanks for big effort and time spent. I am studying your file and trying to understand your coding. I will let you know.
I am working on Office 2016 Professional Plus

 

[Phantom1]

Thanks BSALV.
Seems ok but couldn't make the code to run . Perhaps of my excel version (Office 2016 Professional Plus)
Doesn't bother if we enter manually number of own parts. we could use formula rounddown(ItemsOfCompany*10%,0)

I also notice that the first column doesn't add up to the total items given for company A.

 

[Fluff]

I am working on Office 2016 Professional Plus

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’)