VBA or solver? Model for allocation of pipe-lengths with more constraints.

[DonKampfello]

Hi Experts

I run a small business where I produce and sell pipes in different widths, made out of a soft glas material which I purchase in the form of "Rolls". I want to automate my purchasing process so I dont waste material. Here is my worksheet: Excel solver exampel MKSO.xlsx

1. In yellow I have the dimensions
2. In Blue i have my forcasted Rolls demand amount I need to purchase. This is the amount of "rolls" of each dimension I have to make.
3. We have the big material rolls in bulk, purchased from my supplier, that I make cuts from to the right widht. And waste from cutting the roll.
4. In the lightgreen Array, is where I want to create my model. I am not sure where to start since im new to Data Science, so I am looking for the easiest tool that Excel can offer. VBA/Solver/functions etc.

Basically, Im trying to find a way to fill out all the cells and figure out which kind of combination I should cut. This would give me an idea of how many bulk roolls of 4 m I should buy from the supplier, so I end up with an equal sum of "Purchasing rolls" to my demand.

Any help would be highly appreciated. Even a pointing finger to what I should research.

I hope this makes sense.


Best from a small business owner.

 

[BSALV]

solver
It's repeating "VBA+Solver".
Each time you solve your constraints for just 1 pipe and you force the biggest dimension into the solution (row12), because that's the most "trouble shooting" one.
Then you look how many times, you can use this solution in cell AK12 for the remaining parts.
Now VBA copies that solution and the cells AK12 (number of duplicates) and the waste to your table
And you can start over until everything is done.

In AK7 and AK8, you see the number of pipes of 4 m and the total waste.

Sub Oplossen()
     myoffset = 5
     mymax = 100
     With Sheets("Ark1")
          Set c = .Range("C11:AG11")     'the variables of the solver
          Set c1 = .Range("AK12")     'cell with the number of duplicates
          c.Offset(myoffset).Resize(mymax, c.Columns.Count + 2).ClearContents     'reset previous solutions

          Do     'start loop
               Result = SolverSolve(True)
               SolverFinish KeepFinal:=1

               Select Case Result     'what kind of result had the solver
                    Case 0:     ' Result = 0, Solution found, optimality and constraints satisfied
                    Case 1:     ' Result = 1, Converged, constraints satisfied
                    Case 2:     ' Result = 2, Cannot improve, constraints satisfied
                    Case 3:     ' Result = 3, Stopped at maximum iterations
                    Case 4: MsgBox "Solver did not converge", vbCritical: Exit Sub
                    Case 5: MsgBox "No feasible solution", vbCritical: Exit Sub
                    Case 14
                    Case Else: MsgBox "????": Exit Sub
               End Select

               b = (c1.Value > 0 And c1.Value < 1E+99)     'the number of duplicates, is that feasible ?
               If b Then     'okay
                    With c.Offset(myoffset + ptr)     'range to write
                         .Value = c.Value     'write the variables
                         .Offset(, c.Columns.Count).Resize(, 2).Value = Array(c1.Value, c1.Offset(-1).Value)     'write the number of duplicates and waste
                    End With
               End If
               ptr = ptr + 1     'pointer+1

          Loop While b And ptr < mymax     'loop until everything is solved or max 130
     End With
End Sub

Excel solver exampel MKSO.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL
1
2
3		250	200	225	250	300	350	375	380	400	410	450	490	500	515	530	565	600	618	620	670	700	720	721	757	770	800	825	900	927	1000	1030	1200
4		Dimension/Widht (m)	0,660	0,742	0,825	0,990	1,155	1,237	1,253	1,319	1,352	1,484	1,616	1,649	1,699	1,748	1,864	1,979	2,039	2,045	2,210	2,309	2,375	2,378	2,497	2,540	2,639	2,721	2,969	3,058	3,299	3,398	3,958
5		Lenght (Demand)	4895,7	443	79457	99428	4865,8	74	127,5	21976	667,5	262,8	21	12939	190,1	340	219	8480,9	909,6	388,5	43,7	3722,6	49,4	287,4	252	151,7	4185,2	148,5	991,5	27,2	2102	337	118,6
6		Rolls (Demand)	20	2	318	398	20	1	1	88	3	2	1	52	1	2	1	34	4	2	1	15	1	2	2	1	17	1	4	1	9	2	1
7			>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=			Total :	12.558
8		Purchasing rolls	1	1	1	1	2	1	1	2	1	1	1	1	3	1	1	2	2	2	2	2	1	2	2	3	2	3	2	3	2	1	1			Total waste:	6.369,660
9
10		remaining
11		solver																																	<=	4	4,0000	<--------Waste
12		biggest																																			9E+99	<------Count
13		Rolls	Only entire rolls
14
15		Combination																																Total	Waste
16		1																															1	1200	0,042
17		2																														1		1030	0,602
18		3	1																												1			200	0,042
19		4																													1			800	0,701
20		5			1																									1				250	0,117
21		6		1																										1				225	0,200
Ark1

Cell Formulas
Range	Formula
C6:AG6	C6	=ROUNDUP(C5/$B$3,0)
C8:AG8	C8	=SUM(C13:C55)
AK7	AK7	=SUM(AH16:AH130)
AK8	AK8	=SUMPRODUCT(AH16:AH130,AI16:AI130)
C10:AG10	C10	=C3-SUMPRODUCT(C16:C130,$AH$16:$AH$130)
AH11	AH11	=SUMPRODUCT(C11:AG11,C4:AG4)
C12:AG12	C12	=--(C4=$AH$12)
AH12	AH12	=MAX(IF(($C$10:$AG$10>0)*($C$4:$AG$4<=$AJ$11),$C$4:$AG$4))
AK11	AK11	=+AJ11-AH11
AK12	AK12	=TRUNC(MIN(IF(C11:AG11=0,9E+99,C10:AG10/C11:AG11)))

Named Ranges
Name	Refers To	Cells
MyResults	='Ark1'!$C$16:$AG$130	C10, C8
'Ark1'!solver_adj	='Ark1'!$C$11:$AG$11	AK12, AH11
'Ark1'!solver_lhs1	='Ark1'!$AH$11	AK11
'Ark1'!solver_lhs2	='Ark1'!$C$11:$AG$11	AK12, AH11
'Ark1'!solver_lhs3	='Ark1'!$C$11:$AG$11	AK12, AH11
'Ark1'!solver_rhs1	='Ark1'!$AJ$11	AK11, AH12
'Ark1'!solver_rhs2	='Ark1'!$C$10:$AG$10	AK12, AH12
'Ark1'!solver_rhs4	='Ark1'!$C$11:$AG$11	AK12, AH11

 

[DonKampfello]

solver
It's repeating "VBA+Solver".
Each time you solve your constraints for just 1 pipe and you force the biggest dimension into the solution (row12), because that's the most "trouble shooting" one.
Then you look how many times, you can use this solution in cell AK12 for the remaining parts.
Now VBA copies that solution and the cells AK12 (number of duplicates) and the waste to your table
And you can start over until everything is done.

In AK7 and AK8, you see the number of pipes of 4 m and the total waste.

Sub Oplossen()
     myoffset = 5
     mymax = 100
     With Sheets("Ark1")
          Set c = .Range("C11:AG11")     'the variables of the solver
          Set c1 = .Range("AK12")     'cell with the number of duplicates
          c.Offset(myoffset).Resize(mymax, c.Columns.Count + 2).ClearContents     'reset previous solutions

          Do     'start loop
               Result = SolverSolve(True)
               SolverFinish KeepFinal:=1

               Select Case Result     'what kind of result had the solver
                    Case 0:     ' Result = 0, Solution found, optimality and constraints satisfied
                    Case 1:     ' Result = 1, Converged, constraints satisfied
                    Case 2:     ' Result = 2, Cannot improve, constraints satisfied
                    Case 3:     ' Result = 3, Stopped at maximum iterations
                    Case 4: MsgBox "Solver did not converge", vbCritical: Exit Sub
                    Case 5: MsgBox "No feasible solution", vbCritical: Exit Sub
                    Case 14
                    Case Else: MsgBox "????": Exit Sub
               End Select

               b = (c1.Value > 0 And c1.Value < 1E+99)     'the number of duplicates, is that feasible ?
               If b Then     'okay
                    With c.Offset(myoffset + ptr)     'range to write
                         .Value = c.Value     'write the variables
                         .Offset(, c.Columns.Count).Resize(, 2).Value = Array(c1.Value, c1.Offset(-1).Value)     'write the number of duplicates and waste
                    End With
               End If
               ptr = ptr + 1     'pointer+1

          Loop While b And ptr < mymax     'loop until everything is solved or max 130
     End With
End Sub

Excel solver exampel MKSO.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL
1
2
3		250	200	225	250	300	350	375	380	400	410	450	490	500	515	530	565	600	618	620	670	700	720	721	757	770	800	825	900	927	1000	1030	1200
4		Dimension/Widht (m)	0,660	0,742	0,825	0,990	1,155	1,237	1,253	1,319	1,352	1,484	1,616	1,649	1,699	1,748	1,864	1,979	2,039	2,045	2,210	2,309	2,375	2,378	2,497	2,540	2,639	2,721	2,969	3,058	3,299	3,398	3,958
5		Lenght (Demand)	4895,7	443	79457	99428	4865,8	74	127,5	21976	667,5	262,8	21	12939	190,1	340	219	8480,9	909,6	388,5	43,7	3722,6	49,4	287,4	252	151,7	4185,2	148,5	991,5	27,2	2102	337	118,6
6		Rolls (Demand)	20	2	318	398	20	1	1	88	3	2	1	52	1	2	1	34	4	2	1	15	1	2	2	1	17	1	4	1	9	2	1
7			>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=	>=			Total :	12.558
8		Purchasing rolls	1	1	1	1	2	1	1	2	1	1	1	1	3	1	1	2	2	2	2	2	1	2	2	3	2	3	2	3	2	1	1			Total waste:	6.369,660
9
10		remaining
11		solver																																	<=	4	4,0000	<--------Waste
12		biggest																																			9E+99	<------Count
13		Rolls	Only entire rolls
14
15		Combination																																Total	Waste
16		1																															1	1200	0,042
17		2																														1		1030	0,602
18		3	1																												1			200	0,042
19		4																													1			800	0,701
20		5			1																									1				250	0,117
21		6		1																										1				225	0,200
Ark1

Cell Formulas
Range	Formula
C6:AG6	C6	=ROUNDUP(C5/$B$3,0)
C8:AG8	C8	=SUM(C13:C55)
AK7	AK7	=SUM(AH16:AH130)
AK8	AK8	=SUMPRODUCT(AH16:AH130,AI16:AI130)
C10:AG10	C10	=C3-SUMPRODUCT(C16:C130,$AH$16:$AH$130)
AH11	AH11	=SUMPRODUCT(C11:AG11,C4:AG4)
C12:AG12	C12	=--(C4=$AH$12)
AH12	AH12	=MAX(IF(($C$10:$AG$10>0)*($C$4:$AG$4<=$AJ$11),$C$4:$AG$4))
AK11	AK11	=+AJ11-AH11
AK12	AK12	=TRUNC(MIN(IF(C11:AG11=0,9E+99,C10:AG10/C11:AG11)))

Named Ranges
Name	Refers To	Cells
MyResults	='Ark1'!$C$16:$AG$130	C10, C8
'Ark1'!solver_adj	='Ark1'!$C$11:$AG$11	AK12, AH11
'Ark1'!solver_lhs1	='Ark1'!$AH$11	AK11
'Ark1'!solver_lhs2	='Ark1'!$C$11:$AG$11	AK12, AH11
'Ark1'!solver_lhs3	='Ark1'!$C$11:$AG$11	AK12, AH11
'Ark1'!solver_rhs1	='Ark1'!$AJ$11	AK11, AH12
'Ark1'!solver_rhs2	='Ark1'!$C$10:$AG$10	AK12, AH12
'Ark1'!solver_rhs4	='Ark1'!$C$11:$AG$11	AK12, AH11

Sorry for late reply. With some tweaks, I got it to work, thank you very very much.

Can u be of any help with one last question?

You can see in column D the amount of times the combination was used, which is what the solver has outputted (Awsome). I would like to "Lookup" all the combinations that have been used in the Array (D4:M199). Is their a function that returns multiple columns if the cell has a positive value. If the value posetive = true, then the row should be returned as shown in Q4:Y4.

Can this be done?

Worksheet

Mappe 2.xlsx

Microsoft Excel Workbook

1drv.ms

 

[BSALV]

Sorry for late reply. With some tweaks, I got it to work,

that is for the 3 mm you loose every time you cut the pipe ??? You didn't mention, so i didn't care ...

Your new question, I don't understand what you want to achieve.

 

[DonKampfello]

You code was very helpfull, so thank you for that. My "Excel-English" is not the best, so maybe I did not explain carefully enough the purpose of the Solver. But thanks anyway.

As for my question. The column D marked in red is the amount of times i have used the combination in yellow. The spreadsheet information is copied from the solver where I got the correct output.
I am trying to find a function to put in Q4 that returns the cells in column D,E,F,G,H,K and L if D4 has a positve value (if the combination was used). Is this possible?

 

[BSALV]

i have no clue, can you show several lines of what you expect as result and why ?
I think you want every unique value of for example "Dim 1", but what do you want in columns X and Y ?

 

[DonKampfello]

i have no clue, can you show several lines of what you expect as result and why ?
I think you want every unique value of for example "Dim 1", but what do you want in columns X and Y ?

I have tried to illustrate with the blue rows, which entries I want to return. The reason for this, is that I want a summery of which combinations are used, how many times and the total sum of the waste.

I don't need to see the combinations that has not been used. So if a cell in column D is 0, I dont need it returned.

Im planning on adding many more combinations, and it take alot of time copying them over manually. Again thanks for your time.

 

[DonKampfello]

Got it to work. Thanks for your time.

=IFERROR(INDEX(AR$12:AR$207;SMALL(IF($AQ$12:$AQ$207>0;ROW(AR$12:BA$207)-ROW(AR$12)+1);ROWS(BD$12:BD12)));"")

 

[BSALV]

this is an advanced filter, so see the condition in O3:O4 and the macro

Mappe 2 (1).xlsb
	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA
1
2			Combination
3		Ammount	dim1	dim2	dim3	dim4	dim5	dim6	Total	Waste	Waste IF		Ammount		Ammount	dim1	dim2	dim3	dim4	dim5	dim6	Total	Waste IF
4		1	3.958						3.958	0.042	0.042		>0		1	3.958						3.958	0.042
5		2	3.398						3.398	0.602	1.205				2	3.398						3.398	1.205
6		9	3.299	0.660					3.958	0.042	0.374				9	3.299	0.660					3.958	0.374
7		2	3.058	0.825					3.883	0.117	0.235				2	3.058	0.825					3.883	0.235
8		0	3.058	0.742					3.800	0.200	0.000				4	2.969	0.825					3.793	0.826
9		0	3.058	0.660					3.718	0.282	0.000				1	2.721	1.237					3.958	0.042
10		0	2.969	0.990					3.958	0.042	0.000				1	2.639	1.253					3.892	0.108
11		4	2.969	0.825					3.793	0.207	0.826				1	2.540	1.319					3.859	0.141
12		1	2.721	1.237					3.958	0.042	0.042				2	2.497	0.825	0.660				3.981	0.037
13		1	2.639	1.253					3.892	0.108	0.108				1	2.378	1.616					3.995	0.005
14		0	2.639	1.237					3.876	0.124	0.000				1	2.378	0.825	0.742				3.945	0.055
15			2.639	1.319					3.958	0.042					1	2.375	1.616					3.991	0.009
16		0	2.639	0.660	0.660				3.958	0.042	0.000				19	2.309	1.649					3.958	0.790
Ark1

Sub MyAdvancedFilter()

     With Sheets("Ark1")
          .Range(.Range("D3"), .Range("D" & Rows.Count).End(xlUp)).Resize(, 10).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("O3:O4"), CopyToRange:=.Range("Q3:Y3"), Unique:=False
     End With
End Sub

 

[BSALV]

you have excel365, so you can use the new filter-functions (i think you're using another range as source

=IFERROR(INDEX(FILTER(D4:M1000,D4:D1000>0),SEQUENCE(COUNTIF(D4:D1000,">0")),TRANSPOSE({1,2,3,4,5,6,7,8,10})),"-")

see AA4
mappe2