First and Last?

[jon110763]

Hi All,
I have a table showing contents, by serial #, in numbered storage boxes, which increase daily

Example. Each box could have different quantities

Serial#	Box#	Comments
A100	Box 001	Photos
A101	Box 001
A102	Box 001
B100	Box 002	Documents
B101	Box 002
B102	Box 002
C100	Box 003	Products
C101	Box 003
C102	Box 003

<tbody>
</tbody>

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

Box#	First	Last	Comments
Box 001	A100	A102	Photos
Box 002	B100	B102	Documents
Box 003	C100	C102	Products

<tbody>
</tbody>

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

 

[Fluff]

Will you only ever have 1 comment per box with the other lines blank?

 

[jon110763]

Will you only ever have 1 comment per box with the other lines blank?

hi Fluff,
The boxes do not always have comments, generally tho, one comment/box
thanks

 

[Fluff]

Ok, how about

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

 

[jon110763]

Ok, how about

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,

Serial#	Box#	Comments
A100	Box 001	Photos
A101	Box 001a	Special
A102	Box 001a	Special
A103	Box 001	Photos
A104	Box 001	Photos
B100	Box 002	Documents
B101	Box 002	Documents
B102	Box 002a	Special
B103	Box 002a	Special
B104	Box 002	Documents
C100	Box 003	Products
C101	Box 003
C102	Box 003

<tbody>
</tbody>

Output would then be;

Box#	First	Last	Comments
Box 001	A100	A100	Photos
Box 001a	A101	A102	Special
Box 001	A103	A104	Photos
Box 002	B100	B100	Documents
Box 002a	B102	B103	Special
Box 002	B104	B104	Documents
Box 003	C100	C102	Products

<tbody>
</tbody>

Jon

 

[Fluff]

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

Excel 2013/2016
	A	B	C
1	Serial#	Box#	Comments
2	A100	Box 001	Photos
3	A101	Box 001a	Special
4	A102	Box 001a	Special
5	A103	Box 001b	Photos
6	A104	Box 001b	Photos
7	B100	Box 002	Documents
8	B101	Box 002	Documents
9	B102	Box 002a	Special
10	B103	Box 002a	Special
11	B104	Box 002b	Documents
12	C100	Box 003	Products
13	C101	Box 003
14	C102	Box 003
Proposal

Then you could use the same macro

 

[jon110763]

The easiest way would be for you to add a b to the second set of boxes like
Excel 2013/2016

	A	B	C
1	Serial#	Box#	Comments
2	A100	Box 001	Photos
3	A101	Box 001a	Special
4	A102	Box 001a	Special
5	A103	Box 001b	Photos
6	A104	Box 001b	Photos
7	B100	Box 002	Documents
8	B101	Box 002	Documents
9	B102	Box 002a	Special
10	B103	Box 002a	Special
11	B104	Box 002b	Documents
12	C100	Box 003	Products
13	C101	Box 003
14	C102	Box 003

<colgroup><col style="width: 25pxpx"><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Proposal​

Then you could use the same macro

unfortunately i dont have a "B" box. the items continue in the original box

 

[Peter_SSs]

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;

Box#	First	Last	Comments
Box 001	A100	A100	Photos
Box 001a	A101	A102	Special
Box 001	A103	A104	Photos
Box 002	B100	B100	Documents
Box 002a	B102	B103	Special
Box 002	B104	B104	Documents
Box 003	C100	C102	Products

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
	A	B	C	D
1	Serial#	Box#	Comments
2	A100	Box 001	Photos
3	A101	Box 001a	Special
4	A102	Box 001a	Special
5	A103	Box 001	Photos
6	A104	Box 001	Photos
7	B100	Box 002	Documents
8	B101	Box 002	Documents
9	B102	Box 002a	Special
10	B103	Box 002a	Special
11	B104	Box 002	Documents
12	C100	Box 003	Products
13	C101	Box 003
14	C102	Box 003
15
16
17	Box#	First	Last	Comments
18	Box 001	A100	A100	Photos
19	Box 001a	A101	A102	Special
20	Box 001	A103	A104	Photos
21	Box 002	B100	B101	Documents
22	Box 002a	B102	B103	Special
23	Box 002	B104	B104	Documents
24	Box 003	C100	C102	Products
25
Boxes

However, if you prefer a macro, try this one.

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.

 

[jon110763]

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

 

[Peter_SSs]

You are very welcome. Glad it was what you wanted.