Complicated sum
Closer than close!!
Thanks a lot for your help and sorry to seek another mod, i'm sure it took a
while to get to here. Is it possible to check for one last problem -
disappearing results.
When I have four inputs, both of which will have two ouputs as the weights
are over 400 i loose one of results. Example below
----------------Results--------------
A 100 D 2100
A 2000 D 2000 A 100 D 100 D 4000 (2000 of A missing)
If i introduce a third product (replace the first D with a B), I get the
same result product A missing 2000. If I then make it the worst case, four
different products all overthe limit the results is two items missing
quantities.
--------------Results--------------
C 5000 B 2100 C 200 B 100 B 2000
A 2000 D 2000 A 0 D 0 D 2000
If the first two columns and are kept for the bobines that are <=400 and the
last two are for the multiples of 400 (whole full bobines only) maybe this is
the easiest way to ensure that all will be counted?
I have to send u some beer over for your efforts!
LiAD
"Joel" wrote:
I lited all the changes I made and then the new code
Changes to fix columns
from
.Range(NewCol & RowCount).Offset(0, 3) = NewProduct
.Range(NewCol & RowCount).Offset(0, 4) = Order - 400
to
.Range(NewCol & RowCount).Offset(0, 2) = NewProduct
.Range(NewCol & RowCount).Offset(0, 3) = Order - 400
Change to fix combining orders
from
If Order <= 400 Then
If Order + Quant <= 400 Then
OldOrder(OldItem) = Order
Else
to
If Order + Quant <= 400 Then
If Order <= 400 Then
OldOrder(OldItem) = Order
Else
To make last row multiple of 400 I used two bobines instead of 3 (100,
3600).
Also see if you like the result in this case
A 150
A 250 A 3200
A 500
from
.Range(NewCol & RowCount) = NewProduct
.Range(NewCol & RowCount).Offset(0, 1) = 400
.Range(NewCol & RowCount).Offset(0, 3) = NewProduct
.Range(NewCol & RowCount).Offset(0, 4) = Order - 400
to
Remainder = Order Mod 400
.Range(NewCol & RowCount) = NewProduct
.Range(NewCol & RowCount).Offset(0, 1) = Remainder
.Range(NewCol & RowCount).Offset(0, 2) = NewProduct
.Range(NewCol & RowCount).Offset(0, 3) = Order - Remainder
New Code
Sub CombineOrders()
Dim OldProduct(1 To 2)
Dim OldOrder(1 To 2)
'arrays fill with in the following order
'1 = Col A and Col B data
'2 = Col C and Col D
'3 = Next Row Col A and Col B
'4 = Next Row Col C and Col D
Dim NextProduct(1 To 4)
Dim NextOrder(1 To 4)
With Sheets("bobines")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To 4
NextProduct(i) = ""
NextOrder(i) = 0
Next i
For i = 1 To 2
OldOrder(i) = 0
OldProduct(i) = ""
Next i
For RowCount = 2 To LastRow
NextProduct(1) = .Range("A" & RowCount)
NextOrder(1) = .Range("B" & RowCount)
NextProduct(2) = .Range("C" & RowCount)
NextOrder(2) = .Range("D" & RowCount)
NextProduct(3) = .Range("A" & (RowCount + 1))
NextOrder(3) = .Range("B" & (RowCount + 1))
NextProduct(4) = .Range("C" & (RowCount + 1))
NextOrder(4) = .Range("D" & (RowCount + 1))
'loop twice, one for column A-B and then C-D
For Item = 1 To 2
If .Range("E" & RowCount) = "" Then
NewCol = "E"
Else
NewCol = "G"
End If
If Item = 1 Then
NewProduct = .Range("A" & RowCount)
NewOrder = .Range("B" & RowCount)
Else
NewProduct = .Range("C" & RowCount)
NewOrder = .Range("D" & RowCount)
End If
If NewProduct < "" Then
'see if new product matches one of products on bobines
If NewProduct = OldProduct(1) Then
OldItem = 1
Else
If NewProduct = OldProduct(2) Then
OldItem = 2
Else
'does not match, see which bobine is empty
If OldProduct(1) = "" Then
OldItem = 1
OldProduct(OldItem) = NewProduct
Else
If OldProduct(2) = "" Then
OldItem = 2
OldProduct(OldItem) = NewProduct
Else
'2nd bobine should be empty, if not error
Stop
End If
End If
End If
End If
Order = OldOrder(OldItem) + NewOrder
Found = False
For CompareItem = (Item + 1) To 4 'don't compare against itself
If NextProduct(Item) = NextProduct(CompareItem) Then
NextItem = CompareItem
Found = True
Exit For
End If
Next CompareItem
If Found = True Then
'product matches
Quant = NextOrder(NextItem)
If Order + Quant <= 400 Then
If Order <= 400 Then
OldOrder(OldItem) = Order
Else
.Range(NewCol & RowCount) = NewProduct
.Range(NewCol & RowCount).Offset(0, 1) = Order
OldProduct(OldItem) = ""
OldOrder(OldItem) = 0
End If
Else
OldOrder(OldItem) = Order
End If
Else
'Product doesn't match put on bobbines
If Order <= 400 Then
.Range(NewCol & RowCount) = NewProduct
.Range(NewCol & RowCount).Offset(0, 1) = Order
Else
Remainder = Order Mod 400
.Range(NewCol & RowCount) = NewProduct
.Range(NewCol & RowCount).Offset(0, 1) = Remainder
.Range(NewCol & RowCount).Offset(0, 2) = NewProduct
.Range(NewCol & RowCount).Offset(0, 3) = Order - Remainder
End If
OldProduct(OldItem) = ""
OldOrder(OldItem) = 0
End If
End If
Next Item
Next RowCount
End With
End Sub
"LiAD" wrote:
Hot stuff. Love it!
Its super close but there are just a few little things Ive noticed.
Grouping doesnt seem to work in cases such as the following
Inputs ------ Results given -------
A 150 A 3200 A 150
A 250 A 400 A 3050
In this case the formula should give two only A's, 400 and 3200.
If I try the same inputs but in a different order I get a different result
Inputs ------------- Results given---------
A 150
A 250 A 3200 A 400 A 400 A 2800
- Is it possible to have the same outputs in the two cases above?
- Is it possible to assure that the last output is always a multiple of 400,
so for example if we replaced the 3200 with 3300 the outputs would be
400,100,3200?
- Is there a way of ensuring the position of the results is constant?
In the example below it puts the last result for C one space to the right,
is it possible to line up this result with the others?
A 50
A 50 A 200 A 300
A 200 C 100 A 200 C 100
B 300 B 300
B 175 B 300 B 175
B 55 C 500 B 355
C 125 C 400 C 225
The last C in the bottom right should be below the C four cells above (col
G) rather than the 100 (col H).
Thanks a million for your help
LiAD
-------------------------------------------
"Joel" wrote:
Try this. Should work in both cases
Sub CombineOrders()
Dim OldProduct(1 To 2)
Dim OldOrder(1 To 2)
'arrays fill with in the following order
'1 = Col A and Col B data
'2 = Col C and Col D
'3 = Next Row Col A and Col B
'4 = Next Row Col C and Col D
Dim NextProduct(1 To 4)
Dim NextOrder(1 To 4)
With Sheets("bobines")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To 4
NextProduct(i) = ""
NextOrder(i) = 0
Next i
For i = 1 To 2
OldOrder(i) = 0
OldProduct(i) = ""
Next i
For RowCount = 2 To LastRow
NextProduct(1) = .Range("A" & RowCount)
NextOrder(1) = .Range("B" & RowCount)
NextProduct(2) = .Range("C" & RowCount)
NextOrder(2) = .Range("D" & RowCount)
NextProduct(3) = .Range("A" & (RowCount + 1))
NextOrder(3) = .Range("B" & (RowCount + 1))
NextProduct(4) = .Range("C" & (RowCount + 1))
NextOrder(4) = .Range("D" & (RowCount + 1))
'loop twice, one for column A-B and then C-D
For Item = 1 To 2
If .Range("E" & RowCount) = "" Then
NewCol = "E"
Else
NewCol = "G"
End If
If Item = 1 Then
NewProduct = .Range("A" & RowCount)
NewOrder = .Range("B" & RowCount)
Else
NewProduct = .Range("C" & RowCount)
NewOrder = .Range("D" & RowCount)
End If
If NewProduct < "" Then
'see if new product matches one of products on bobines
If NewProduct = OldProduct(1) Then
OldItem = 1
Else
If NewProduct = OldProduct(2) Then
OldItem = 2
Else
'does not match, see which bobine is empty
If OldProduct(1) = "" Then
OldItem = 1
OldProduct(OldItem) = NewProduct
Else
If OldProduct(2) = "" Then
OldItem = 2
|