# User:Eriksiers/Knapsack problem

This is my not-quite-working version of another VB solution to the unbounded knapsack problem. (The actual solution is Knapsack Problem/Visual Basic.) I didn't base this version on the one that's posted; I wanted to do it all on my lonesome. It's significantly shorter than the actual solution, but...

I didn't put it up there because there's something not quite right here; it goes over the limits by one panacea and one gold. Also, it picks the first version that works, and doesn't list all solutions (but I think I could handle that in just a few lines.) Also also, it doesn't go through all permutations of the list.

Maybe I'll fix it some day, maybe not. Probably not.

```Type item
name As String
value As Long
weight As Long  ' divide by 10 for actual weight
volume As Long  ' divide by 1000 for actual volume
End Type

Private treasures(2) As item

Const MAX_WEIGHT = 250
Const MAX_VOLUME = 250

Private Sub buildTable()
With treasures(0)
.name = "panacea"
.value = 3000
.weight = 3
.volume = 25
End With
With treasures(1)
.name = "ichor"
.value = 1800
.weight = 2
.volume = 15
End With
With treasures(2)
.name = "gold"
.value = 2500
.weight = 20
.volume = 2
End With
End Sub

Sub BruteForceFillBackpack()
Dim L0 As Long, L1 As Long, L2 As Long
Dim volumeLeft As Long, weightLeft As Long
Dim tmpVl As Long, tmpWt As Long, tmpNum As Long

Dim maxTake(2) As Long

Dim finalChoice(2) As Long, finalValue As Long, outP As String

buildTable

tmpVl = MAX_VOLUME \ treasures(0).volume
tmpWt = MAX_WEIGHT \ treasures(0).weight
maxTake(0) = IIf(tmpVl < tmpWt, tmpVl, tmpWt) 'lower number needed

For L0 = 0 To maxTake(0)
volumeLeft = MAX_VOLUME - (treasures(0).volume * L0)
weightLeft = MAX_WEIGHT - (treasures(0).weight * L0)

tmpVl = volumeLeft \ treasures(1).volume
tmpWt = weightLeft \ treasures(1).weight
maxTake(1) = IIf(tmpVl < tmpWt, tmpVl, tmpWt) 'lower number again
For L1 = 0 To maxTake(1)
volumeLeft = MAX_VOLUME - (treasures(1).volume * L1)
weightLeft = MAX_WEIGHT - (treasures(1).weight * L1)

tmpVl = volumeLeft \ treasures(2).volume
tmpWt = weightLeft \ treasures(2).weight
maxTake(2) = IIf(tmpVl < tmpWt, tmpVl, tmpWt) 'and again

tmpNum = (treasures(0).value * L0) + (treasures(1).value * L1) + (treasures(2).value * maxTake(2))
If tmpNum > finalValue Then
finalChoice(0) = L0
finalChoice(1) = L1
finalChoice(2) = maxTake(2)
finalValue = tmpNum
End If
Next
Next

For L0 = 0 To 2
outP = outP & treasures(L0).name & ":" & finalChoice(L0) & vbNewLine
Next
outP = outP & "Total value:" & finalValue & vbNewLine
outP = outP & "Total weight:" & Str\$(((treasures(0).weight * finalChoice(0)) + (treasures(1).weight * finalChoice(1)) + (treasures(2).weight * finalChoice(2))) / 10!) & vbNewLine
outP = outP & "Total volume:" & Str\$(((treasures(0).volume * finalChoice(0)) + (treasures(1).volume * finalChoice(1)) + (treasures(2).volume * finalChoice(2))) / 1000!)

MsgBox outP
End Sub
```