Determine optimal method for choosing products based on perimeter and number of zones

We need to setup a more efficient quote system for prospective clients, but the logic is difficult to implement (I'm using VBA, but a formula or pseudocode is fine). This seems to be a combinatorial optimization problem. The criteria is mostly uniform, but there are some edge cases that contradict the normal logic that I'll explain at the end.

If the user sets a whole number perimeter and a whole number of zones, I need to determine the best combination of merchandise with attributes that equal the number of zones and meet or minimally exceed the perimeter. Note that the merchandise without any zones can be used once the zones have been accounted for with other merchandise and only perimeter is left to be satisfied. If I were to set my desired perimeter to 1000ft and zones to 2, the ideal merchandise combination would be RB-I2Z500, which is 1000ft and has 2 zones. If I set the perimeter to 1100ft and 3 zones it would be RB-I2Z250, RB-I1Z500, and RB-I100 since they are (250 x 2) + 500 + 100 = 1100ft and 2 zones + 1 zone + 0 zone = 3 zones.

You might notice that other combinations would also work, but the justification for one specific combination is that it would be the lowest price (not shown) to the client. You may notice the yellow highlighted rows in the table - these are not actual products, but I put them there to help facilitate my current partial solution. In conjunction with the Distance column (also added by me), I determine the distance between a perimeter quotient (the user's specified feet divided by the user's specified number of zones) and each product's total feet. This has been helpful in coming up with the correct combination in most, but not all, situations. It just requires a lot of branching conditions to force the program to choose the combination with the lowest total price.

If you think you understand everything above, there is one additional criteria, which is that the user must specify a minimum number of feet in relation to their number of zones since there are no possible combinations that satisfy the number of zones and feet under that minimum. This works out to be 250ft * zones, so if they choose 3 zones they need to set their perimeter to at least 750ft. Now the main edge case falls in the range between (250ft * zones) to (250ft * (zones + 1)), which in the former example of 3 zones would be 750 to 1000ft. Within this range there is a special condition called a split, which is allowed to convert one of the kits into an extra zone by cutting the cable and using a special item to join it as needed.

For me at least, this has been an incredibly complex project, and I've left out a lot of complications in the hope that I don't scare anyone away. I will post my current code below the table. Note that some of the code deals with converting from feet to meters, so that can be safely ignored.

Sub CalculateProductCodes()
Dim rngProduct As Range, rngMinDist As Range
Dim rngCodes As Range, rngFound As Range
Dim rngAdd As Range, rngZonesLeft As Range
Dim rngMinPerim As Range, rngSplit As Range
Dim rngMetrics As Range
Dim sSystem As String, sAbbr As String
Dim sCode As String, sProductCodes() As String
Dim bSplit As Boolean, bMult As Boolean
Dim bZero As Boolean
Dim dPerimeter As Double, dPerimeterLeft As Double
Dim dPerimeterQuotient As Double, dPerimeterMinus As Double
Dim dMinDistance As Double
Dim lMinPerim As Long, lBaseFeetOrMeters As Long
Dim lS As Long, lM As Long, lL As Long
Dim vFeetOrMeters() As Variant, vMetrics As Variant
Dim iZones As Integer, iZonesLeft As Integer
Dim iIndex As Integer, iMod As Integer
Dim iDualSingle As Integer, iProduct As Integer
Dim i As Integer, j As Integer

Set rngMetrics = wksBOM.Range("Metrics")
Set rngProduct = wksCalc.Range("Products") ' From merchandise table
Set rngCodes = wksCalc.Range("ResultCodes") ' Not shown, output area
Set rngMinDist = wksCalc.Range("MinDist") ' This confines the possible results to a specific portion of the table depending on the chosen system.
Set rngAdd = wksCalc.Range("AdditionalLine") ' Special item used to join split cable
Set rngZonesLeft = wksCalc.Range("ZonesLeft")  ' Tracks zones left after each iteration of loop, which makes sense as you get further down
Set rngMinPerim = wksCalc.Range("MinPerimeterSplit") ' 250 * no of zones
Set rngSplit = wksCalc.Range("Split") ' Whether split condition is active or not

rngZonesLeft.Value = wksBOM.Range("Zones").Value ' User specified no of zones
sSystem = wksBOM.Range("System").Value ' user specified system type
dPerimeter = wksBOM.Range("Perimeter").Value ' user specified perimeter
iZones = rngZonesLeft.Value

' All of this block is used further down in the calculations
' some of it is for converting between feet and meters
' but other parts are for reducing the initial result from
' the Distance column to the preferred result
If rngMetrics.Value = "Feet" And sSystem = "IRON" Then
vMetrics = Array("100", "250", "375", "500", "750", "1000")
lBaseFeetOrMeters = 250: iMod = 1
lS = 100: lM = 250: lL = 500
ElseIf rngMetrics.Value = "Meters" And sSystem = "IRON" Then
vMetrics = Array("30", "75", "114", "150", "229", "305")
lBaseFeetOrMeters = 75: iMod = 1
lS = 30: lM = 75: lL = 152
ElseIf rngMetrics.Value = "Feet" And sSystem <> "IRON" Then
vMetrics = Array("250", "375", "500", "750", "1000")
lBaseFeetOrMeters = 250
lS = 100: lM = 250: lL = 500
ElseIf rngMetrics.Value = "Meters" And sSystem <> "IRON" Then
vMetrics = Array("75", "114", "150", "229", "305")
lBaseFeetOrMeters = 75
lS = 30: lM = 75: lL = 152
End If

ReDim vFeetOrMeters(0 To UBound(vMetrics))

' Converts ft to meters
For i = 0 To UBound(vMetrics)
vFeetOrMeters(i) = vMetrics(i)
Next i

' For use in creating product codes where necessary
If sSystem = "IRON" Then
sAbbr = "I"
ElseIf sSystem = "MIKE" Then
sAbbr = "M"
Else
sAbbr = "W"
End If

' Because the Iron system has a 100ft denomination, this helps check to see
' if the 100ft product code will need to be used in the final combination.
' If bMult = True then it will be used, otherwise no.
If sSystem = "IRON" And _
(dPerimeter Mod lBaseFeetOrMeters) > 0 And _
(dPerimeter Mod lBaseFeetOrMeters) <= 100 Then bMult = True

' Determines if the split condition is in effect based on the users perimeter.
' If the users perimeter is lower than the min threshold, exit sub.
If dPerimeter >= rngMinPerim.Cells(1, 1).Value And dPerimeter < rngMinPerim.Cells(2, 1).Value Then
bSplit = True
rngSplit.Value = True
ElseIf dPerimeter < rngMinPerim.Cells(1, 1).Value Then
rngCodes.Value = "None"
Exit Sub
Else
bSplit = False
rngSplit.Value = False
End If

dPerimeterLeft = dPerimeter
iZonesLeft = iZones: iProduct = 0

' Early exit condition
If dPerimeter <= 0 Or iZones <= 0 Then
rngCodes.Value = "None"
Exit Sub
End If

' Main loop that runs as long as the remaining perimeter to be assigned
' a product to is greater than zero.
Do While dPerimeterLeft > 0

rngZonesLeft.Value = iZonesLeft
bZero = False

Application.Calculate

If iZonesLeft = 0 Or iZonesLeft = 1 Then

' This is used to determine the Distance column values
dPerimeterQuotient = dPerimeterLeft

' Sets the Distance column values with this formula.
rngProduct.Offset(0, 6).Resize(rngProduct.Rows.Count, 1).Formula2 = "=" & rngProduct.Cells(1, 4).Address(False, False) & "-" & dPerimeterQuotient
ElseIf iZonesLeft >= 2 Then

' dPerimeterQuotient is only different from dPerimeterLeft if iZonesLeft is >= 2
dPerimeterQuotient = dPerimeterLeft / iZonesLeft
rngProduct.Offset(0, 6).Resize(rngProduct.Rows.Count, 1).Formula2 = "=" & rngProduct.Cells(1, 4).Address(False, False) & "-" & dPerimeterQuotient
End If

dMinDistance = rngMinDist.Value ' This is the value that is closest to zero while still being positive and that is within the correct table range determined by which system is chosen by the user.

' iDualSingle is used to determine (under most circumstances) whether the product is a dual-zone, single zone, or feet only product.
If iZonesLeft >= 2 Then
iDualSingle = 2
ElseIf iZonesLeft = 1 Then
iDualSingle = 1
Else
iDualSingle = 0
End If

' Loops through all 39 products and return result that matches all of these criteria
For i = 1 To 39

If rngProduct.Cells(i, 2).Value = sSystem And _
rngProduct.Cells(i, 3).Value = iDualSingle And _
rngProduct.Cells(i, 7).Value = dMinDistance Then

' stores current index in case the result needs to be reduced later
iIndex = i

' Unless reduced, this will be one of the end results to be output
sCode = rngProduct.Cells(i, 6).Value

' Will be subtracted from dPerimeterLeft after each loop, but this value might change.
dPerimeterMinus = rngProduct.Cells(i, 5).Value

Exit For

End If

Next i

If sCode = "" Then Exit Do

' Special circumstance that will come into play further down.
If iZonesLeft = 0 And dPerimeterLeft - dPerimeterMinus <= 0 Then bZero = True

' lBaseFeetOrMeters is typically 250 when using Feet.
' These next conditions will reduce the product code to the next one down in
' the table if condition is met in order to be most efficient.
' When this happens it will also adjust sCode, dPerimeterMinus, and iDualSingle
' where applicable.
If (dPerimeterLeft - dPerimeterMinus) < -lBaseFeetOrMeters And _
(iZonesLeft - iDualSingle) >= 0 Then

For i = iIndex To 1 Step -1
If rngProduct.Cells(i, 5).Value < dPerimeterMinus And _
rngProduct.Cells(i, 2).Value = sSystem Then
sCode = rngProduct.Cells(i, 6).Value
dPerimeterMinus = rngProduct.Cells(i, 5).Value
iDualSingle = rngProduct.Cells(i, 3).Value
Exit For
End If
Next i

ElseIf (dPerimeterLeft - dPerimeterMinus) <= 0 And _
(iZonesLeft - iDualSingle) > 0 Then

For i = iIndex To 1 Step -1
If rngProduct.Cells(i, 5).Value < dPerimeterMinus And _
rngProduct.Cells(i, 2).Value = sSystem Then
sCode = rngProduct.Cells(i, 6).Value
dPerimeterMinus = rngProduct.Cells(i, 5).Value
iDualSingle = rngProduct.Cells(i, 3).Value
Exit For
End If
Next i

' If this is true, it adds the special product code to the output

ElseIf (dPerimeterLeft - dPerimeterMinus) <= 0 And _
(iZonesLeft - iDualSingle) >= 0 And bSplit Then

For i = iIndex To 1 Step -1
If rngProduct.Cells(i, 5).Value < dPerimeterMinus And _
rngProduct.Cells(i, 2).Value = sSystem Then
sCode = rngProduct.Cells(i, 6).Value
dPerimeterMinus = rngProduct.Cells(i, 5).Value
iDualSingle = rngProduct.Cells(i, 3).Value
Exit For
End If
Next i

' Also for the split condition, adds specified number of connector product

ElseIf dPerimeterLeft <= 0 Then

Exit Do

End If

' Reduces dPerimeterLeft by dPerimeterMinus & iZonesLeft by iDualSingle
dPerimeterLeft = dPerimeterLeft - dPerimeterMinus
iZonesLeft = iZonesLeft - iDualSingle

ReDim Preserve sProductCodes(iProduct)

' These check what number of feet (or meters) are in the product code.
' For the rows highlighted in yellow, since they are not actual products
' they will be spun off into the two real products that it represents.
If InStr(1, sCode, vFeetOrMeters(3 + iMod)) Then
sCode = Replace(sCode, vFeetOrMeters(3 + iMod), vFeetOrMeters(2 + iMod))
sProductCodes(iProduct) = sCode
iProduct = iProduct + 1

ReDim Preserve sProductCodes(iProduct)

If dPerimeterLeft <= -lS Then
sProductCodes(iProduct) = "RB-" & sAbbr & lS
dPerimeterLeft = dPerimeterLeft + 150
Else
sProductCodes(iProduct) = "RB-" & sAbbr & lM
End If

iProduct = iProduct + 1

ElseIf InStr(1, sCode, vFeetOrMeters(1 + iMod)) Then
sCode = Replace(sCode, vFeetOrMeters(1 + iMod), vFeetOrMeters(iMod))
sProductCodes(iProduct) = sCode
iProduct = iProduct + 1

ReDim Preserve sProductCodes(iProduct)

If dPerimeterLeft <= -lS Then
sProductCodes(iProduct) = "RB-" & sAbbr & lS
Else
sProductCodes(iProduct) = "RB-" & sAbbr & lM
End If

iProduct = iProduct + 1
Else
sProductCodes(iProduct) = sCode
iProduct = iProduct + 1
End If

' Similar to the above conditions, but only applies in a special edge case where
' both dPerimeterLeft and iZonesLeft are 0 (or less than 0 in case of perimeter).
If bMult And bZero Then

If InStr(1, sProductCodes(iProduct - 1), vFeetOrMeters(iMod)) Then
sProductCodes(iProduct - 1) = "RB-" & sAbbr & lS
ElseIf InStr(1, sProductCodes(iProduct - 1), vFeetOrMeters(1 + iMod)) Then
sProductCodes(iProduct - 1) = "RB-" & sAbbr & lM

ReDim Preserve sProductCodes(iProduct)

sProductCodes(iProduct) = "RB-" & sAbbr & lS
iProduct = iProduct + 1
ElseIf InStr(1, sProductCodes(iProduct - 1), vFeetOrMeters(4 + iMod)) Then
ReDim Preserve sProductCodes(iProduct + 1)
sProductCodes(iProduct - 1) = "RB-" & sAbbr & lL
sProductCodes(iProduct) = "RB-" & sAbbr & lM
sProductCodes(iProduct + 1) = "RB-" & sAbbr & lS
iProduct = iProduct + 2
End If

End If

Loop

' sets all output cells to None so prior executions do not get included in results
rngCodes.Value = "None"

For j = 0 To iProduct - 1
rngCodes.Cells(j + 1, 1).Value = sProductCodes(j)
Next j



End Sub

• Are you allowed to pick the same product more than once? Also, several products with M in the code have IRON instead of MIKE as the System. Is that expected? Dec 30, 2023 at 15:33
• @RobPratt Yes you can choose the same product as many times as needed. Also, thanks for catching that. I was obscuring the real product names and made a mistake. I've corrected the table, thank you. For some additional context, this is for a security perimeter system. Dec 30, 2023 at 15:46

Without the splits, you want to solve a two-dimensional knapsack problem with equality constraints. Let $$P$$ be the set of products. For product $$i\in P$$, let $$c_i$$, $$p_i$$, and $$z_i$$ be the cost, perimeter, and number of zones, respectively. Let $$\bar{p}$$ and $$\bar{z}$$ be the required perimeter and number of zones. Let nonnegative integer decision variable $$x_i$$ be the number of times that product $$i$$ is selected. The problem is to minimize $$\sum_{i\in P} c_i x_i$$ subject to \begin{align} \sum_{i\in P} p_i x_i &= \bar{p} \tag1\label1 \\ \sum_{i\in P} z_i x_i &= \bar{z} \tag2\label2 \end{align}