Sorting Automation for Pallets and Boxes

[Gotchaman]

At our warehouse we ship hundreds of boxes everyday. Warehouse guys load boxes on pallets and then scan pallet ID's and box ID's, then upload the scanned data to the system.
When I download the records, it is all in one line containing pallet IDs and Box IDs as shown below. Pallets ID's (bold in this example) are in numerical order.
So, the A1 value is always the first pallet ID.

Excel Workbook
	A
1	000000004352
2	136016484001
3	018490316001
4	017023735001
5	018619171001
6	018619165001
7	017068487001
8	000000004353
9	017070233001
10	017053072001
11	017052845001
12	018617358001
13	017052885001
14	136028205001
15	017053056001
16	018210505001
17	000000004354
18	136004557001
19	017060663001
20	017070806001
21	017060659001
22	017044247001
23	018040312001
24	017060667001
25	000000004355
26	136027691001
27	017067792001
28	017161670001
29	017060246001
Before

Excel 2007

My goal is to separate them by pallets as shown below. Boxes don't need to be sorted. Sometimes there are 10 pallets, sometimes 20 pallets, you never know. So the loop must work for as long as there are pallets.

Can someone please help with an automate job to do this? We have been doing this manually (find next pallet ID, cut and paste on the next column) and looking for a faster way. Thank you very much!

Excel Workbook
	A	B	C	D
1	000000004352	000000004353	000000004354	000000004355
2	136016484001	017070233001	136004557001	136027691001
3	018490316001	017053072001	017060663001	017067792001
4	017023735001	017052845001	017070806001	017161670001
5	018619171001	018617358001	017060659001	017060246001
6	018619165001	017052885001	017044247001
7	017068487001	136028205001	018040312001
8		017053056001	017060667001
9		018210505001
After

 

[Gotchaman]

Actually I tested this script and works only if I know exactly how many pallets. How can I make this work regardless of the number of pallets?

Sub PalletSorter()
    Dim i As String
    Range("A1").Select
    x = 1
    Do Until x = 13
        i = ActiveCell.Value
        i = i + 1
        Cells.Find(What:=i, After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        Range(Selection, Selection.End(xlDown)).Select
        Application.CutCopyMode = False
        Selection.Cut
        Cells(Selection.Row, Columns.Count).End(xlToLeft).Offset(, 1).Select
        Selection.End(xlUp).Select
        ActiveSheet.Paste
        Selection.End(xlUp).Select
        x = x + 1
       Loop
    
End Sub

 

[Gotchaman]

anyone?

 

[gregtx81]

See how this works. Select (highlight) the cells and run it.

Option Explicit
Sub PalletSorter()
    
    Dim rUsing As Range, rPallet As Range, rPriorPallet As Range
    Dim sNextPallet As String
    Dim ct As Long
    
    Set rUsing = Selection
    
    If rUsing.Columns.Count > 1 Or rUsing.Cells.Count < 2 Or rUsing.Areas.Count > 1 Then
        MsgBox "This macro requires: the selection of multiple and contiguous cells that are all within a single column.  Now exiting."
        Exit Sub
    End If
    
    Set rPallet = rUsing.Cells(1)
    
    ct = 0
    Do While Not rPallet Is Nothing
        
        sNextPallet = Application.WorksheetFunction.Rept("0", Len(rUsing.Cells(1).Value) - Len(rPallet.Value + 1)) & rPallet.Value + 1
        Set rPriorPallet = rPallet
        Set rPallet = rUsing.Cells.Find(What:=sNextPallet, After:=rPallet, SearchDirection:=xlNext)

        ct = ct + 1
        
        If Not rPallet Is Nothing Then
            Range(rPriorPallet, rPallet.Offset(-1)).Copy Destination:=rUsing.Cells(1).Offset(, ct + 3)
        Else
            Range(rPriorPallet, rUsing.Cells(rUsing.Cells.Count)).Copy Destination:=rUsing.Cells(1).Offset(, ct + 3)
        End If
    Loop
    
    Range(rUsing.Cells(1).Offset(, 3), rUsing.Cells(1).Offset(, 3 + ct)).Font.Bold = True
End Sub

 

[Gotchaman]

Thanks gregtx81 for your help

When I run the script, I get this message: This macro requires: the selection of multiple and contiguous cells that are all within a single column. Now exiting.

 

[gregtx81]

You've got to select (highlight) the cells you want the macro to run on... they don't have to start in A1.


If you have a lot of cells, activate the first one(click it or use keyboard arrows), then hold ctrl+shift and press the down arrow to select all of them.

 

[Gotchaman]

Great! It worked. Thank you so much!