First and Last?

jon110763

New Member
Joined
Oct 17, 2013
Messages
16
Hi All,
I have a table showing contents, by serial #, in numbered storage boxes, which increase daily

Example. Each box could have different quantities
[TABLE="class: grid, width: 300"]
<tbody>[TR]
[TD]Serial#[/TD]
[TD]Box#[/TD]
[TD]Comments[/TD]
[/TR]
[TR]
[TD]A100[/TD]
[TD]Box 001[/TD]
[TD]Photos[/TD]
[/TR]
[TR]
[TD]A101[/TD]
[TD]Box 001[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A102[/TD]
[TD]Box 001[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B100[/TD]
[TD]Box 002[/TD]
[TD]Documents[/TD]
[/TR]
[TR]
[TD]B101[/TD]
[TD]Box 002[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B102[/TD]
[TD]Box 002[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C100[/TD]
[TD]Box 003[/TD]
[TD]Products[/TD]
[/TR]
[TR]
[TD]C101[/TD]
[TD]Box 003[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C102[/TD]
[TD]Box 003[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Im looking to
  1. identify each storage box #
  2. identify the first serial # in each box
  3. identify the last serial # in each box
hopefully providing me with data to extract for a box label

Example

[TABLE="class: grid, width: 300"]
<tbody>[TR]
[TD]Box#[/TD]
[TD]First[/TD]
[TD]Last[/TD]
[TD]Comments[/TD]
[/TR]
[TR]
[TD]Box 001[/TD]
[TD]A100[/TD]
[TD]A102[/TD]
[TD]Photos[/TD]
[/TR]
[TR]
[TD]Box 002[/TD]
[TD]B100[/TD]
[TD]B102[/TD]
[TD]Documents[/TD]
[/TR]
[TR]
[TD]Box 003[/TD]
[TD]C100[/TD]
[TD]C102[/TD]
[TD]Products[/TD]
[/TR]
</tbody>[/TABLE]


i hope this is explained well enough for someone to provide a solution. I'm struggling with 2000+ boxes at the moment and increasing by 20 per day.

thank you, and please ask if anything needs clarifying

Jon
 
Last edited:

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Will you only ever have 1 comment per box with the other lines blank?
 
Upvote 0
Ok, how about
Code:
Sub BxLbls()
   Dim cl As Range
   Dim tmp
   With CreateObject("scripting.dictionary")
      For Each cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
         If Not .exists(cl.Value) Then
            .Add cl.Value, Array(cl.Offset(, -1).Value, cl.Offset(, -1).Value, cl.Offset(, 1).Value)
         ElseIf cl.Offset(, -1) > .Item(cl.Value)(1) Then
            tmp = .Item(cl.Value)
            tmp(1) = cl.Offset(, -1).Value
            .Item(cl.Value) = tmp
         End If
      Next cl
      Range("F1").Resize(.Count).Value = Application.Transpose(.keys)
      Range("G1").Resize(.Count, 3).Value = Application.Index(.items, 0, 0)
   End With
End Sub
 
Upvote 0
Ok, how about
Code:
Sub BxLbls()
   Dim cl As Range
   Dim tmp
   With CreateObject("scripting.dictionary")
      For Each cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
         If Not .exists(cl.Value) Then
            .Add cl.Value, Array(cl.Offset(, -1).Value, cl.Offset(, -1).Value, cl.Offset(, 1).Value)
         ElseIf cl.Offset(, -1) > .Item(cl.Value)(1) Then
            tmp = .Item(cl.Value)
            tmp(1) = cl.Offset(, -1).Value
            .Item(cl.Value) = tmp
         End If
      Next cl
      Range("F1").Resize(.Count).Value = Application.Transpose(.keys)
      Range("G1").Resize(.Count, 3).Value = Application.Index(.items, 0, 0)
   End With
End Sub


Fluff,
Thank you , that's working great. Can I add another criteria?

I also have on occasion, items in sequence that needs to be stored separately, and then the sequence continues in the original box.

So,
[TABLE="width: 223"]
<tbody>[TR]
[TD]Serial#[/TD]
[TD]Box#[/TD]
[TD]Comments[/TD]
[/TR]
[TR]
[TD]A100[/TD]
[TD]Box 001[/TD]
[TD]Photos[/TD]
[/TR]
[TR]
[TD]A101[/TD]
[TD]Box 001a[/TD]
[TD]Special[/TD]
[/TR]
[TR]
[TD]A102[/TD]
[TD]Box 001a[/TD]
[TD]Special[/TD]
[/TR]
[TR]
[TD]A103[/TD]
[TD]Box 001[/TD]
[TD]Photos[/TD]
[/TR]
[TR]
[TD]A104[/TD]
[TD]Box 001[/TD]
[TD]Photos[/TD]
[/TR]
[TR]
[TD]B100[/TD]
[TD]Box 002[/TD]
[TD]Documents[/TD]
[/TR]
[TR]
[TD]B101[/TD]
[TD]Box 002[/TD]
[TD]Documents[/TD]
[/TR]
[TR]
[TD]B102[/TD]
[TD]Box 002a[/TD]
[TD]Special[/TD]
[/TR]
[TR]
[TD]B103[/TD]
[TD]Box 002a[/TD]
[TD]Special[/TD]
[/TR]
[TR]
[TD]B104[/TD]
[TD]Box 002[/TD]
[TD]Documents[/TD]
[/TR]
[TR]
[TD]C100[/TD]
[TD]Box 003[/TD]
[TD]Products[/TD]
[/TR]
[TR]
[TD]C101[/TD]
[TD]Box 003[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C102[/TD]
[TD]Box 003[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Output would then be;
[TABLE="width: 318"]
<tbody>[TR]
[TD]Box#[/TD]
[TD]First[/TD]
[TD]Last[/TD]
[TD]Comments[/TD]
[/TR]
[TR]
[TD]Box 001[/TD]
[TD]A100[/TD]
[TD]A100[/TD]
[TD]Photos[/TD]
[/TR]
[TR]
[TD]Box 001a[/TD]
[TD]A101[/TD]
[TD]A102[/TD]
[TD]Special[/TD]
[/TR]
[TR]
[TD]Box 001[/TD]
[TD]A103[/TD]
[TD]A104[/TD]
[TD]Photos[/TD]
[/TR]
[TR]
[TD]Box 002[/TD]
[TD]B100[/TD]
[TD]B100[/TD]
[TD]Documents[/TD]
[/TR]
[TR]
[TD]Box 002a[/TD]
[TD]B102[/TD]
[TD]B103[/TD]
[TD]Special[/TD]
[/TR]
[TR]
[TD]Box 002[/TD]
[TD]B104[/TD]
[TD]B104[/TD]
[TD]Documents[/TD]
[/TR]
[TR]
[TD]Box 003[/TD]
[TD]C100[/TD]
[TD]C102[/TD]
[TD]Products[/TD]
[/TR]
</tbody>[/TABLE]


Jon
 
Upvote 0
The easiest way would be for you to add a b to the second set of boxes like

Excel 2013/2016
ABC
1Serial#Box#Comments
2A100Box 001Photos
3A101Box 001aSpecial
4A102Box 001aSpecial
5A103Box 001bPhotos
6A104Box 001bPhotos
7B100Box 002Documents
8B101Box 002Documents
9B102Box 002aSpecial
10B103Box 002aSpecial
11B104Box 002bDocuments
12C100Box 003Products
13C101Box 003
14C102Box 003
Proposal


Then you could use the same macro
 
Upvote 0
The easiest way would be for you to add a b to the second set of boxes like
Excel 2013/2016
ABC
Serial#Box#Comments
A100Box 001Photos
A101Box 001aSpecial
A102Box 001aSpecial
A103Box 001bPhotos
A104Box 001bPhotos
B100Box 002Documents
B101Box 002Documents
B102Box 002aSpecial
B103Box 002aSpecial
B104Box 002bDocuments
C100Box 003Products
C101Box 003
C102Box 003

<colgroup><col style="width: 25pxpx"><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]

[TD="align: center"]3[/TD]

[TD="align: center"]4[/TD]

[TD="align: center"]5[/TD]

[TD="align: center"]6[/TD]

[TD="align: center"]7[/TD]

[TD="align: center"]8[/TD]

[TD="align: center"]9[/TD]

[TD="align: center"]10[/TD]

[TD="align: center"]11[/TD]

[TD="align: center"]12[/TD]

[TD="align: center"]13[/TD]

[TD="align: right"][/TD]

[TD="align: center"]14[/TD]

[TD="align: right"][/TD]

</tbody>
Proposal



Then you could use the same macro


unfortunately i dont have a "B" box. the items continue in the original box
 
Upvote 0
Best not to fully quote long posts as it makes the thread harder to read/navigate. If you want to quote, quote small, relevant parts only, as I have done here.


Output would then be;
[TABLE="width: 318"]
[TR]
[TD]Box#[/TD]
[TD]First[/TD]
[TD]Last[/TD]
[TD]Comments[/TD]
[/TR]
[TR]
[TD]Box 001[/TD]
[TD]A100[/TD]
[TD]A100[/TD]
[TD]Photos[/TD]
[/TR]
[TR]
[TD]Box 001a[/TD]
[TD]A101[/TD]
[TD]A102[/TD]
[TD]Special[/TD]
[/TR]
[TR]
[TD]Box 001[/TD]
[TD]A103[/TD]
[TD]A104[/TD]
[TD]Photos[/TD]
[/TR]
[TR]
[TD]Box 002[/TD]
[TD]B100[/TD]
[TD]B100[/TD]
[TD]Documents[/TD]
[/TR]
[TR]
[TD]Box 002a[/TD]
[TD]B102[/TD]
[TD]B103[/TD]
[TD]Special[/TD]
[/TR]
[TR]
[TD]Box 002[/TD]
[TD]B104[/TD]
[TD]B104[/TD]
[TD]Documents[/TD]
[/TR]
[TR]
[TD]Box 003[/TD]
[TD]C100[/TD]
[TD]C102[/TD]
[TD]Products[/TD]
[/TR]
[/TABLE]
I disagree with the highlighted value - hopefully it was a typo on your part. :)

This could be done by formula, though it may become a bit cumbersome with large data.

Each formula copied down after adjusting to your actual ranges.

Excel Workbook
ABCD
1Serial#Box#Comments
2A100Box 001Photos
3A101Box 001aSpecial
4A102Box 001aSpecial
5A103Box 001Photos
6A104Box 001Photos
7B100Box 002Documents
8B101Box 002Documents
9B102Box 002aSpecial
10B103Box 002aSpecial
11B104Box 002Documents
12C100Box 003Products
13C101Box 003
14C102Box 003
15
16
17Box#FirstLastComments
18Box 001A100A100Photos
19Box 001aA101A102Special
20Box 001A103A104Photos
21Box 002B100B101Documents
22Box 002aB102B103Special
23Box 002B104B104Documents
24Box 003C100C102Products
25
Boxes




However, if you prefer a macro, try this one.
Code:
Sub Boxes()
  Dim a As Variant, b As Variant
  Dim i As Long, r As Long
  
  a = Range("A1:C" & Range("A" & Rows.Count).End(xlUp).Row + 1).Value
  ReDim b(1 To UBound(a), 1 To 4)
  For i = 2 To UBound(a) - 1
    If a(i, 2) <> a(i - 1, 2) Then
      r = r + 1
      b(r, 1) = a(i, 2): b(r, 2) = a(i, 1): b(r, 4) = a(i, 3)
    End If
    If a(i, 2) <> a(i + 1, 2) Then b(r, 3) = a(i, 1)
  Next i
  With Range("A" & Rows.Count).End(xlUp).Offset(4).Resize(r, 4)
    .Value = b
    .Offset(-1).Resize(1).Value = Array("Box#", "First", "Last", "Comments")
  End With
End Sub

For me, the results of this code are identical to the formula results above.
 
Upvote 0
Peter,

That code works perfectly as required.
I have applied it to Saturdays report of 5300 rows with a resulting first and last contents of each of the 8 boxes.
That has saved me a few hours work on a daily basis, and will speed up the search for items within each box.

Thank you so much.


Fluff, Thank you for your efforts also.

Jon
 
Upvote 0
You are very welcome. Glad it was what you wanted. :)
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top