0
$\begingroup$

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.

Merchandise Table

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

rngAdd.Value = 0
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
        If bSplit Then rngAdd.Value = rngAdd.Value + iZonesLeft - 1
    
    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
        rngAdd.Value = rngAdd.Value + iZonesLeft - 1
        
    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

If rngAdd.Value >= 2 Then rngAdd.Value = rngAdd.Value - 1

End Sub

$\endgroup$
2
  • $\begingroup$ 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? $\endgroup$
    – RobPratt
    Dec 30, 2023 at 15:33
  • $\begingroup$ @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. $\endgroup$ Dec 30, 2023 at 15:46

1 Answer 1

1
$\begingroup$

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}

$\endgroup$
3
  • $\begingroup$ I will test this in Solver and get back to you, thanks. $\endgroup$ Dec 30, 2023 at 18:10
  • $\begingroup$ It took me a while, but once I set up the supporting code your solution worked very well. Thanks. $\endgroup$ Dec 31, 2023 at 15:36
  • $\begingroup$ @StarnesStudent Glad to help, and welcome to OR StackExchange! $\endgroup$
    – RobPratt
    Dec 31, 2023 at 15:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.