Complicated sum
Looks like the money shot right there!
Thanks a lot
"Joel" wrote:
the code worked fine. i just was over-writing the data column G
from
If .Range("E" & RowCount) = "" Then
NewCol = "E"
Else
NewCol = "G"
End If
to
If .Range("E" & RowCount) = "" Then
NewCol = "E"
Else
If .Range("G" & RowCount) = "" Then
NewCol = "G"
Else
NewCol = "I"
End If
End If
update 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
If .Range("G" & RowCount) = "" Then
NewCol = "G"
Else
NewCol = "I"
End If
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:
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
|