Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Complicated sum
 
 
LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #13   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 386
Default 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
Reply With QuoteReply With Quote
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Threaded Mode Threaded Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Complicated Look-Up Greg Excel Discussion (Misc queries) 1 January 19th 10 05:05 PM
a little complicated Gaurav[_2_] Excel Worksheet Functions 7 March 18th 08 12:12 AM
Something perhaps a little complicated brodiemac Excel Discussion (Misc queries) 3 June 13th 06 03:15 PM
Complicated Brett Excel Worksheet Functions 3 January 6th 06 03:29 PM
It's getting a bit complicated Ctech[_9_] Excel Programming 2 October 4th 05 10:24 PM


All times are GMT +1. The time now is 07:14 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright Š2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement