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