We get an export from our client (a .csv) that contains all that we need to both build the order(s) and then ship them to our clients' clients (well, usually that is). Anyway, I have set up 3 templates to manually go through the data and have it set up an export that I can get into UPS WorldShip, but now I am the only one that can ship this stuff, which isn't good.
I am attempting to automate the export as much as possible, so that my co-workers (or my bosses even) can ship these, but I'm both running into problems, and having trouble visualizing exactly HOW to get some of this done (I've ALWAYS had problems w/ arrays greater than 1 dimension). I've gotten a LOT of great stuff from different sites/message boards/the 2 books I've bought (Excel 2010 Bible and VBA and Macros: MS Excel 2010), and I've been able to modify some other examples I've found to do some useful things, but now I'm stumped.
I *THINK* I've gotten the logic down on how to box the pieces, based on some rules I figured out by doing this stuff by hand. We get orders with ~17 part numbers, which I have broken down into 4 types: type 1 has 12 part numbers that are all the same size & weight, and go into 2 different box sizes. BUT, then there is this... the SINGLE PACK holds one, and the TRIPLE PACK holds 1-3, tho we don't put one in it. That means that type 1 items have 3 box types (because the weight of the triple w/ 2 is different than the weight of the triple w/ 3). So, the logic for type 1's is: There can be only ONE single pack OR one triple pack containing 2 items, and as many triple packs containing 3 as needed (I have an arbitrary limit set at 20 atm, as the most needed so far has been 7). The type 2-4 have similar rules also.
One of the places I'm stumped at is the fact that since I haven't been able to figure out how to do an import into WorldShip to do a multiple piece shipment (not what I'm asking here), I need to be able to add lines and copy information for shipments that are multiple boxes. I've tried copying to another sheet entirely, but for some reason I can't get it to add extras to ones that need it. I then thought about trying to add the lines BEFORE copying to another sheet, but that's where I start having problems visualizing wth I'm doing. In the Box Logic module there are several subs I was in the process of trying, I just can't get my mind wrapped around keeping track of things (so I don't copy on top of a previously copied row, etc.).
(Note I use the advanced filter to get out the unique addresses before I do the above).
I've been trying to break up my sub's into smaller groups, so that I can more easily adapt them for the 2 international templates I need to get working (we ship on our clients UPS account(s), so we do US (domestic) on one account number, Canada on the domestic number (but with all the info for international/customs), and international on another account number (along w/ customs info).
I'm also pretty sure that a good bit of my coding could use some, erm, cleaning up? Prettifing? I know that I need to comment better, but that has always been something I've not been good at (blame it on starting in Basic back on a Atari 800 XL and IBM PCjr )
I have included a sample dataset (randomized and zeroed out to protect the innocent), but I've tried to keep the basics of it unchanged to give you an idea of what we get. This is a small order (done, shipped on Monday), as we seem to get 2-5 a week, ranging from 50ish rows to almost 200 per order, with a 3 day turn-around.
* ok, I tried to include a workbook, but can't post attachments. Ok, well, here's my VBA code, now just need to figure out how to post some sample data...
Any help is greatly appreciated, or even a nudge in the direction of something that I can read to figure this stuff out. I've been on a crash course on this since September, so I've learned quite a bit, but I know I still have a good ways to go.
I am attempting to automate the export as much as possible, so that my co-workers (or my bosses even) can ship these, but I'm both running into problems, and having trouble visualizing exactly HOW to get some of this done (I've ALWAYS had problems w/ arrays greater than 1 dimension). I've gotten a LOT of great stuff from different sites/message boards/the 2 books I've bought (Excel 2010 Bible and VBA and Macros: MS Excel 2010), and I've been able to modify some other examples I've found to do some useful things, but now I'm stumped.
I *THINK* I've gotten the logic down on how to box the pieces, based on some rules I figured out by doing this stuff by hand. We get orders with ~17 part numbers, which I have broken down into 4 types: type 1 has 12 part numbers that are all the same size & weight, and go into 2 different box sizes. BUT, then there is this... the SINGLE PACK holds one, and the TRIPLE PACK holds 1-3, tho we don't put one in it. That means that type 1 items have 3 box types (because the weight of the triple w/ 2 is different than the weight of the triple w/ 3). So, the logic for type 1's is: There can be only ONE single pack OR one triple pack containing 2 items, and as many triple packs containing 3 as needed (I have an arbitrary limit set at 20 atm, as the most needed so far has been 7). The type 2-4 have similar rules also.
One of the places I'm stumped at is the fact that since I haven't been able to figure out how to do an import into WorldShip to do a multiple piece shipment (not what I'm asking here), I need to be able to add lines and copy information for shipments that are multiple boxes. I've tried copying to another sheet entirely, but for some reason I can't get it to add extras to ones that need it. I then thought about trying to add the lines BEFORE copying to another sheet, but that's where I start having problems visualizing wth I'm doing. In the Box Logic module there are several subs I was in the process of trying, I just can't get my mind wrapped around keeping track of things (so I don't copy on top of a previously copied row, etc.).
(Note I use the advanced filter to get out the unique addresses before I do the above).
I've been trying to break up my sub's into smaller groups, so that I can more easily adapt them for the 2 international templates I need to get working (we ship on our clients UPS account(s), so we do US (domestic) on one account number, Canada on the domestic number (but with all the info for international/customs), and international on another account number (along w/ customs info).
I'm also pretty sure that a good bit of my coding could use some, erm, cleaning up? Prettifing? I know that I need to comment better, but that has always been something I've not been good at (blame it on starting in Basic back on a Atari 800 XL and IBM PCjr )
I have included a sample dataset (randomized and zeroed out to protect the innocent), but I've tried to keep the basics of it unchanged to give you an idea of what we get. This is a small order (done, shipped on Monday), as we seem to get 2-5 a week, ranging from 50ish rows to almost 200 per order, with a 3 day turn-around.
* ok, I tried to include a workbook, but can't post attachments. Ok, well, here's my VBA code, now just need to figure out how to post some sample data...
Code:
' Trying to set up boxing logic for client
' This is not gonna be fun
'
' Put BoxLogic() on a button on info tab in some kind of step order w/ others to make easier for newbs
' Started: 11/06/2011
' Last modified: 11/17/2011
Option Explicit
Public i As Long, iCalc As Long ' i = for/next variable, iCalc = throwaway Long
Public iBoxTypeCount(2 To 250, 1 To 11) As Long ' (Row #, Box Type)
Public iTotalBoxTypeCount(250, 4, 3) As Long ' (Row #, Type (1,2,3,4), # in box (1-3 for most, 1-2 for type 2))
Public iX As Long, iY As Long, iZ As Long ' all throwaway Longs
Public iCalc2 As Long, iTotalBoxes(2 To 250) As Long ' iCalc2 throwaway, iTotalboxes = total boxes per address
Public iAddressItemTotals(2 To 250, 1 To 4) As Long ' Total qty of item_id's for each unique address
Public iAddedRows(2 To 250) As Long, iI As Long ' might not need, can delete if not (range)
Public iAddressNumInBox(2 To 250, 1 To 11, 1 To 20) As Long ' (Row, Box Type, Package #)
Public iLastRow As Long, iNewLastRow As Long ' iLastRow = Starting last row of unique addresses, iNewLastRow = iLastRow + any added rows
Sub BoxLogic()
Application.ScreenUpdating = False
Call ZeroOut2 ' Clear out box/total array's in case button is pressed more than 1x
Call GetUnique ' Get initial list of unique addresses
Sheets("Extras1").Activate
iLastRow = Range("F65536").End(xlUp).row ' Find starting last row, data sent to us thus far no longer than 200 lines
iNewLastRow = iLastRow
With Sheets("Extras1") 'SUMIFS($AY$2:$AY$250,$BT$2:$BT$250,"=1",$BH$2:$BH$250,F2)
For i = iLastRow To 2 Step -1
For iX = 1 To 4
iAddressItemTotals(i, iX) = Application.WorksheetFunction.SumIfs(.Range("AY2:AY250"), _
.Range("BT2:BT250"), "=" & iX, .Range("BH2:BH250"), .Range("F" & i).Value)
Next iX
Next i
End With
For i = iLastRow To 2 Step -1
Call RowBoxCount
For iZ = 1 To 11
iTotalBoxes(i) = iTotalBoxes(i) + iBoxTypeCount(i, iZ)
Next iZ
If iTotalBoxes(i) > 1 Then ' Tells AddLines() sub how many rows to add ** AddLines() not added yet **
Range("R" & i) = iTotalBoxes(i) - 1
iNewLastRow = iNewLastRow + iTotalBoxes(i) - 1 ' update newlastrow + (n-1)
Else
Range("R" & i) = 0 ' give it a value
End If
Next i
Call CopyToExtras2Tab
Application.ScreenUpdating = True
End Sub
Sub RowBoxCount() ' Sub to get boxes for each Row
If iAddressItemTotals(i, 1) > 0 Then
Call Type1 ' Part numbers 2,3,4,24,32,33,34,35,36,40,42,45
End If
If iAddressItemTotals(i, 2) > 0 Then
Call Type2 ' Part number 43
End If
If iAddressItemTotals(i, 3) > 0 Then
Call Type3 ' Part numbers 64,108
End If
If iAddressItemTotals(i, 4) > 0 Then
Call Type4 ' Part Numbers 63,106
End If
End Sub
Sub Type1() ' (x, 1, x) for Type 1s
Call ZeroOut
iCalc = iAddressItemTotals(i, 1) Mod 3 ' Get remainder if qty / 3
iCalc2 = Application.WorksheetFunction.Quotient(iAddressItemTotals(i, 1), 3) ' Get quotient of qty / 3
If iAddressItemTotals(i, 1) = 4 Then ' If qty = 4, do 2 and 2, not 1 and 3, per my boss
iBoxTypeCount(i, 1) = 0
iBoxTypeCount(i, 2) = 2
iBoxTypeCount(i, 3) = 0
iAddressNumInBox(i, 1, 1) = 0
iAddressNumInBox(i, 2, 1) = 2
iAddressNumInBox(i, 2, 2) = 2
iAddressNumInBox(i, 3, 1) = 0
Exit Sub
End If
Select Case iCalc ' Per shipment (row), can only have 1 box of 1 OR 1 box of 2, max, not 1 of ea.
Case 2
iX = 0 ' Box type 1, 1/1
iY = 1 ' Box type 2, 2/3
Case 1
iX = 1 ' Box type 1, 1/1
iY = 0 ' Box Type 2, 2/3
End Select
iBoxTypeCount(i, 1) = iX
iBoxTypeCount(i, 2) = iY
iBoxTypeCount(i, 3) = iCalc2
For iZ = 1 To 3
Select Case iZ
Case 1
iAddressNumInBox(i, 1, 1) = iX ' max one box w/ qty 1, 0 w/ qty 2
Case 2
iAddressNumInBox(i, 2, 1) = iY ' max one box w/ qty 2, 0 w/ qty 1
Case 3
For iI = 1 To iBoxTypeCount(i, 3) ' no "real" upper limit on qty 3 boxes, max is 20 atm
iAddressNumInBox(i, 3, iI) = 3
Next iI
End Select
Next iZ
End Sub
Sub Type2() ' (x, 2, x) for Type 2s
Call ZeroOut
iCalc = iAddressItemTotals(i, 2) Mod 2 ' Get remainder of qty / 2
iCalc2 = Application.WorksheetFunction.Quotient(iAddressItemTotals(i, 2), 2) ' Get quotient of qty / 2
iBoxTypeCount(i, 4) = iCalc ' Box Type 4, 1/1, can only have max 1 box of 1
iBoxTypeCount(i, 10) = iCalc2 ' Box Type 10, 2/2
For iZ = 1 To 2
Select Case iZ
Case 1
iAddressNumInBox(i, 4, 1) = iCalc ' max one box w/ qty 1
Case 2
iAddressNumInBox(i, 10, 2) = iCalc2 ' no "real" upper limit on qty 2 boxes, max is 20 atm
End Select
Next iZ
End Sub
Sub Type3() ' (x, 3, x) for Type 3s
Call ZeroOut
iCalc = iAddressItemTotals(i, 3) Mod 3 ' Get remainder of qty / 3
iCalc2 = Application.WorksheetFunction.Quotient(iAddressItemTotals(i, 3), 3) ' Get quotient of qty / 3
If iAddressItemTotals(i, 1) = 4 Then ' If qty = 4, do 2 and 2, not 1 and 3, per my boss
iBoxTypeCount(i, 7) = 0
iBoxTypeCount(i, 8) = 2
iBoxTypeCount(i, 9) = 0
iAddressNumInBox(i, 7, 0) = 0
iAddressNumInBox(i, 8, 1) = 2
iAddressNumInBox(i, 8, 2) = 2
iAddressNumInBox(i, 9, 0) = 0
Exit Sub
End If
Select Case iCalc ' can only have 1 box of 1 OR 1 box of 2 per shipment (row), max
Case 2
iX = 0 ' Box type 7, 1/3
iY = 1 ' Box type 8, 2/3
Case 1
iX = 1 ' Box type 7, 1/3
iY = 0 ' Box Type 8, 2/3
End Select
iBoxTypeCount(i, 7) = iX
iBoxTypeCount(i, 8) = iY
iBoxTypeCount(i, 9) = iCalc2 ' Box Type 9 (3/3)
For iZ = 1 To 3
Select Case iZ
Case 1
iAddressNumInBox(i, 7, 1) = iX
Case 2
iAddressNumInBox(i, 8, 1) = iY
Case 3 ' No "real" limit on # of boxes containing 3, limit is 20 atm
For iI = 1 To iBoxTypeCount(i, 3)
iAddressNumInBox(i, 9, iI) = 3
Next iI
End Select
Next iZ
End Sub
Sub Type4() ' (x, 4, x) for Type 4s
Call ZeroOut
iCalc = iAddressItemTotals(i, 4) Mod 3 ' Get remainder of qty / 3
iCalc2 = Application.WorksheetFunction.Quotient(iAddressItemTotals(i, 4), 3) ' get quotient of qty / 3
Select Case iCalc ' can only have 1 box of 1 OR 1 box of 2, max per shipment (row)
Case 2
iX = 0 ' Box type 5, 1/1
iY = 1 ' Box type 6, 2/3
Case 1
iX = 1 ' Box type 5, 1/1
iY = 0 ' Box Type 6, 2/3
End Select
iBoxTypeCount(i, 5) = iX
iBoxTypeCount(i, 6) = iY
iBoxTypeCount(i, 11) = iCalc2 ' Box Type 11, 3/3
For iZ = 1 To 3
Select Case iZ
Case 1
iAddressNumInBox(i, 5, 1) = iX
Case 2
iAddressNumInBox(i, 6, 1) = iY
Case 3 ' no "real" limit of boxes of 3, limit is 20 atm
For iI = 1 To iBoxTypeCount(i, 3)
iAddressNumInBox(i, 11, iI) = 3
Next iI
End Select
Next iZ
End Sub
Sub GetUnique()
'
' GetUnique Macro
' Get unique addresses and put them somewhere else
' From Macro Recorder, could prolly be optimized a bit
Sheets("Extras1").Activate
Range("Bh1:Bh250").AdvancedFilter Action:=xlFilterCopy, CopyToRange:= _
Columns("F:F"), Unique:=True
End Sub
Sub ZeroOut()
iX = 0
iY = 0
iZ = 0
iCalc = 0
iCalc2 = 0
End Sub
Sub ZeroOut2()
For i = 2 To 250
For iI = 1 To 4
iAddressItemTotals(i, iI) = 0
Next iI
For iI = 1 To 4
For iX = 1 To 3
iTotalBoxTypeCount(i, iI, iX) = 0
Next iX
Next iI
iTotalBoxes(i) = 0
For iI = 1 To 11
For iX = 1 To 20
iAddressNumInBox(i, iI, iX) = 0
Next iX
Next iI
Next i
End Sub
Sub CopyToExtras2Tab()
Dim iExtra As Long, iRowNumber As Long, iExxtra As Long, iXxx As Long, iXx As Long
iRowNumber = 2
Do
iXx = iRowNumber + iExtra
Sheets("Extras1").Range("A" & iRowNumber & ":Q" & iRowNumber).Copy
Sheets("Extras2").Range("A" & iXx).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
If Sheets("Extras1").Range("R" & iRowNumber).Value > 0 Then
iExxtra = Sheets("Extras1").Range("R" & iXx).Value
For iXxx = 1 To iExxtra
iExtra = iExtra + 1
iXx = iRowNumber + iExtra
Sheets("Extras1").Range("A" & iRowNumber & ":Q" & iRowNumber).Copy
Sheets("Extras2").Range("A" & iXx).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Next iXxx
End If
iRowNumber = iRowNumber + 1
Loop While iRowNumber <= iLastRow
End Sub
Sub AddLines() ' getting lost trying to code this :/
Dim iExtra As Long, iDun As Long ' supposed to do: read column r value and add "x" # of rows below it
iExtra = 0 ' and copy info into the inserted row(s). Once this is done, can call the above
iDun = 0 ' sub (copy to extras 2) and then fill in missing stuffs.
For i = 2 To iLastRow
iDun = i + iExtra
With Sheets("Extras1")
If .Range("R" & iDun).Value > 0 Then
For iX = 1 To .Range("R" & iDun).Value
.Range("R" & iDun + 1).EntireRow.Select
Selection.Insert Shift:=xlDown
.Range("A" & iDun & ":Q" & iDun).Copy
.Range("A" & iDun + 1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
iExtra = iExtra + 1
Next iX
End If
End With
Next i
End Sub
Sub AddingLinesNStuff() ' another try at rewriting
Dim iFLastRow As Long, iNewFLastRow As Long, iRow As Long, iAdded As Long
Sheets("Extras1").Activate
iFLastRow = Range("F65536").End(xlUp).row
iNewFLastRow = iFLastRow
iRow = 0
iAdded = 0
For i = 2 To 250
iAddedRows(i) = 0
Next i
For i = 2 To iFLastRow
iRow = i + iAdded
With Sheets("Extras1")
.Range("A" & i & ":Q" & i).Copy
Sheets("Extras2").Range("A" & iRow).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
If .Range("R" & i).Value > 1 Then
For iX = 1 To .Range("R" & i).Value
.Range("A" & i & ":Q" & i).Copy
Sheets("Extras2").Range("A" & iRow + iX).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
iAdded = iAdded + 1
iAddedRows(iRow + iX) = 1
Next iX
End If
End With
Next i
Call MissingStuffFillIn(iAdded)
End Sub
Sub MissingStuffFillIn(iAddedRows As Long) ' not even close to done, I'm just lost
Dim iLastRowB As Long
Sheets("Extras2").Activate
iLastRowB = Range("B65536").End(xlUp).row
'iAddressNumInBox(2 To 250, 1 To 11, 1 To 20) As Long ' (Row, Box Type, Package #)
With Sheets("Extras2")
For i = 2 To iLastRowB
For iX = 1 To 11
For iY = 1 To 20
If iAddressNumInBox(i, iX, iY) > 0 Then
.Range("P" & i).Value = iAddressNumInBox(i, iX, iY)
End Sub