How to number sequential items and put number all numbers into a cell with a delimeter

[theloveofwisdom]

Please help me write a vba that can create the data in the second column. Any help will be appreciated. There will be a large amount of tickets, and each individual may purchase as many tickets as they like... probably no more than a few hounded.

# of tickets	ticket #
4	1,2;3;4
3	5;6;7
2	8;9
6	10;11;12;13;14;15
1	16
3	17;18;19

<tbody>
</tbody>

 

[__kon]

Based on your sample data, if "# of tickets" is in cell A1 on sheet 1.
Maybe:

Sub TicketList()
    Dim MyWs As Worksheet
    Dim MyRange As Range
    Dim Count As Integer
    Dim MyString As String
    
    Set MyWs = Worksheets(1)
    Set MyRange = MyWs.Range(MyWs.Cells(2, 1), _
        MyWs.Cells(Rows.Count, 1).End(xlUp))    'Get the used range in column A
    Count = 0
    For Each MyCell In MyRange
        MyString = ""
        For I = 1 To MyCell.Value
            MyString = MyString & (Count + I) & ";"
        Next I
        MyCell.Offset(0, 1).Value = Left(MyString, Len(MyString) - 1)
        Count = Count + MyCell.Value
    Next
End Sub

 

[JoeMo]

Assuming your # of tickets data start in A2, this should be fast if you have many rows. If you have a large number in any single cell, you may want to add a line to wrap text.

Sub TicketNums()
Dim R As Range, Vin As Variant, Vout As Variant, Cum As Long, First  As Long, i As Long, S As String
Set R = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Vin = R.Value
ReDim Vout(1 To UBound(Vin, 1), 1 To 1)
First = 1
For i = LBound(Vin, 1) To UBound(Vin, 1)
       Cum = Cum + Val(Vin(i, 1))
       For j = First To Cum
              S = S & ";" & j
       Next j
       Vin(i, 1) = Right(S, Len(S) - 1)
       First = Cum + 1
       S = ""
Next i
Application.ScreenUpdating = False
R.Offset(0, 1).Value = Vin
R.Columns(1).Offset(0, 1).AutoFit
Application.ScreenUpdating = True
End Sub

 

[theloveofwisdom]

Brilliant! Thank you so very much. works perfectly.

Based on your sample data, if "# of tickets" is in cell A1 on sheet 1.
Maybe:

Sub TicketList()
    Dim MyWs As Worksheet
    Dim MyRange As Range
    Dim Count As Integer
    Dim MyString As String
    
    Set MyWs = Worksheets(1)
    Set MyRange = MyWs.Range(MyWs.Cells(2, 1), _
        MyWs.Cells(Rows.Count, 1).End(xlUp))    'Get the used range in column A
    Count = 0
    For Each MyCell In MyRange
        MyString = ""
        For I = 1 To MyCell.Value
            MyString = MyString & (Count + I) & ";"
        Next I
        MyCell.Offset(0, 1).Value = Left(MyString, Len(MyString) - 1)
        Count = Count + MyCell.Value
    Next
End Sub

 

[theloveofwisdom]

Brilliant! Thank you so very much. Works perfectly. This is a great community.

 

[JoeMo]

If you have a large number of rows, you may want to try the code in post #3 which should be much faster.

 

[mikerickson]

You could use this UDF.
If "# of tickets" is in A1, you could put =NumeralSequence(SUM(A$1:A1)+1,SUM(A$1:A2),";") in B2 and drag down.

Function NumeralSequence(StartWith, EndWith As Long, Optional Delimiter As String = " ") As String
    Dim i As Long
    Dim xVal As Variant
    xVal = Application.Transpose(Evaluate("Row(" & StartWith & ":" & EndWith & ")"))
    NumeralSequence = Join(xVal, Delimiter)
End Function

Or perhaps a single loop.

Sub test()
    Const Delimiter As String = ";"
    Dim oneCell As Range
    Dim startVal As Long, endVal As Long
    Dim outString As String
    
    startVal = 0
    
    With Sheet1.Range("A:A")
        For Each oneCell In Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
            With oneCell
                If Val(CStr(.Value)) <> 0 Then
                
                    endVal = startVal + Val(CStr(.Value))
                    outString = Join(Application.Transpose(Evaluate("ROW(" & startVal + 1 & ":" & endVal & ")")), Delimiter)
                    oneCell.Offset(0, 1).Value = outString
                    startVal = endVal
                    
                End If
            End With
        Next oneCell
    End With
End Sub

 

[theloveofwisdom]

Wow this code is much faster than the code I was using previously.

I have a followup request. What if I want to distinguish between two types of ticket orders. This would seem to need two different counters dependent on the column for # of tickets and the column for Order type. Could the code you gave me above be modified to have two such counters so as to generate the output below in the Ticket #s column? Any input is much appreciated.

First Name	Last Name	Order Type	# of Tickets	Ticket #s
Joe	Smith	Online	7	i1;i2;i3;i4;i5;i6;i7
Steve	Jones	Mail	5	m1;m2;m3;m4;m5
Nick	Smith	Online	5	i8;i9;i10;i11;i12
Nick	Jones	Online	9	i13;i14;i15;i16;i17;i18;i19;i20;i21
Nick	Stevens	Mail	6	m6;m7;m8;m9;m10;m11

<tbody>
</tbody>

 

[JoeMo]

Wow this code is much faster than the code I was using previously.

I have a followup request. What if I want to distinguish between two types of ticket orders. This would seem to need two different counters dependent on the column for # of tickets and the column for Order type. Could the code you gave me above be modified to have two such counters so as to generate the output below in the Ticket #s column? Any input is much appreciated.

First Name	Last Name	Order Type	# of Tickets	Ticket #s
Joe	Smith	Online	7	i1;i2;i3;i4;i5;i6;i7
Steve	Jones	Mail	5	m1;m2;m3;m4;m5
Nick	Smith	Online	5	i8;i9;i10;i11;i12
Nick	Jones	Online	9	i13;i14;i15;i16;i17;i18;i19;i20;i21
Nick	Stevens	Mail	6	m6;m7;m8;m9;m10;m11

<tbody>
</tbody>

You have been given several versions of code. Which one are you referring to?

 

[theloveofwisdom]

My mistake, I was referring to the code by JoeMo, the one below. Can the TicketNum() below be modified to count two separate sequences as the new sample data indicates, or will it have to be completely rewritten?

You have been given several versions of code. Which one are you referring to?

Sub TicketNums()
Dim R As Range, Vin As Variant, Vout As Variant, Cum As Long, First As Long, i As Long, S As String
Set R = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Vin = R.Value
ReDim Vout(1 To UBound(Vin, 1), 1 To 1)
First = 1
For i = LBound(Vin, 1) To UBound(Vin, 1)
Cum = Cum + Val(Vin(i, 1))
For j = First To Cum
S = S & ";" & j
Next j
Vin(i, 1) = Right(S, Len(S) - 1)
First = Cum + 1
S = ""
Next i
Application.ScreenUpdating = False
R.Offset(0, 1).Value = Vin
R.Columns(1).Offset(0, 1).AutoFit
Application.ScreenUpdating = True
End Sub