I've posted on this before but I've got a bit muddled so have posted again. I've attached the spreadsheet I have and the code I have so far is below.
There is a range of numbers (A1:A32 (named "items"). B1 is a user entered number.
The program is supposed to match the value in B1 using the numbers available in A1:A32, but only 1, 2 or 3 items can be used, and the same item cannot be used more than once.
The fewest amount of items also need to be used to either get an exact match or a match within 10% of the target value. If this is not possible, then another item needs to be used and the same process repeated (There a better explanation underneath the code).
Here's the code I have so far which I know matches one number exactly or within 10%, and if duplicate values (such as 200 and 200) matches exactly, but I can't for the life of me take it further. There is more code in the sheet, but I'm still trying to figure out exactly what it's doing (the disorder is so I can try to understand it!).
Dim xItems As Range 'Range a1:a32 - the list of weight values
Dim xTarget As Range 'Range b1 - the entered weight to match
Dim XtargetVal 'The value of the cell b1
Dim J As Long 'This is for a for loop (1 - 32)
Dim xDistance As Single 'This is the difference between the target value and the matched value
'1st condition - (single match exact) - variables.
Set xItems = Range("Items")
Set xTarget = Range("Target")
XtargetVal = Range("Target").Value
For J = 1 To xItems.Count
If XtargetVal = xItems(J) Then
xTarget.Offset(1, 0) = "Exact Match = " & xItems(J)
xTarget.Offset(2, 0) = "x2= N/A "
xTarget.Offset(3, 0) = "Nearest sum= " & XtargetVal
xTarget.Offset(4, 0) = "Difference= " & Format(0, "0.00000")
Exit Sub
End If
Next J
'condition 2 - Use ONE weight to find NEAREST match
Dim K As Long
Dim LowestVal, HighestVal
Set xlowest = Range("lowest")
Set xhighest = Range("highest")
LowestVal = Range("lowest").Value
HighestVal = Range("highest").Value
For K = 1 To xItems.Count
If LowestVal <= xItems(K) And HighestVal >= xItems(K) Then
xTarget.Offset(1, 0) = "Nearest single = " & xItems(K)
xTarget.Offset(2, 0) = "No other weight"
xTarget.Offset(3, 0) = "Nearest sum= " & XtargetVal
xTarget.Offset(4, 0) = "Distance= " & Format(0, "0.00000")
Exit Sub
End If
Next K
End Sub
Conditions to go through in order:
1. Find and use 1 number from A1:A32 that exactly matches the target (B1)
2. Find and use 1 number from A1:A32 that comes within 10% of the target
3. Find and use 2 numbers from A1:A32 that exactly matches the target
4. Find and use 2 numbers from A1:A32 that come within 10% of the target
5. Find and use 3 numbers from A1:A32 that exactly matches the target
6. Find and use 3 numbers from A1:A32 that come within 10% of the target
In any case, the same cell reference cannot be used more than once (so you cannot use the number 1 twice).
Bookmarks