Parsing comma-delimited string of serial numbers - excel

Question

I would like some direction/help on how to code a VBA-coded solution for my scenario, details follow. I am very comfortable with VBA coding - I am really looking for advise on how to approach the problem, not any specific solution.
My department bears the highly-enviable task of daily label-making. We receive a spreadsheet from Production that has a cell/cells of serial numbers to be printed (examples below). The numbers are often not contiguous, but the basic (human-generated) 'format' is the same (hyphens for ranges, commas for single numbers). The serial numbers in the example below are 6 digits, but often are different lengths, adding to the complexity. I am looking for feedback on how to ultimately parse the cell.text into a complete list of serial numbers that can be ultimately used as a source for our label printer's software.
Again, I think I have the ability to actually code this; I am asking how to approach parsing the cell.value(s), identifying spaces, commas, and hyphens as needed, and retrieving a list of serial numbers, in any usable format. I can SPLIT at commas, and I can code the range before and after a hyphen. How do I approach the 6 digit format, as well as the change to the first three characters (364-365, could be many).
EXAMPLE SPREADSHEET CELL.VALUE: "364701-703, 705, 706, 708-710, 365100-104, 121" is a request for 14 labels:
EXPECTED PARSED RESULT: 364701, 364702, 36703, 364705, 364706, 364708, 364709, 364710, 365100, 365101, 365102, 365013, 350104, 365121

Answer 1

It's just a matter of how you keep track of things.
Given your data, the following will output what you want. You will note I added a single serial number item as you only had ranges listed in your sample:
Option Explicit
Sub labelMaker()
Const sRequest As String = "364701-703, 705, 706, 708-710,364800, 365100-104, 121"
Dim V, W, X
Dim lFirstThree As Long, I As Long, J As Long
'Dim D As Dictionary 'early binding
Dim D As Object 'late binding
'Set D = New Dictionary 'early binding
Set D = CreateObject("Scripting.Dictionary") 'late binding
V = Split(Replace(sRequest, " ", ""), ",")
For Each W In V
X = Split(W, "-")
If Len(X(0)) = 6 Then lFirstThree = Left(X(0), 3) 'we start a new series
For I = Right(X(LBound(X)), 3) To Right(X(UBound(X)), 3)
D.Add lFirstThree & I, lFirstThree & I
Next I
Next W
'write the results to the worksheet
V = WorksheetFunction.Transpose(D.Keys)
With Cells(1, 1).Resize(D.Count) 'will be on active sheet
.EntireColumn.Clear
.Value = V
End With
End Sub
The above works only with six digit serial numbers, which is what you provided. I'm reasonably sure the variability can be coded for, but without knowing how they vary (which is the fixed part and which the variable part), it would be hard to provide a one-size fits all solution.

Answer 2

You might code it however you would and post that to https://codereview.stackexchange.com/ and then you could see how some other people might approach it.
I don't have any illuminating advice, so I'll just show you how I'd do it. The splitting is easy enough and you just have to keep track of the first three numbers for when they're missing.
Public Sub GenerateSerialNumbers(ByVal sNumbers As String)
Dim vaComma As Variant, vaHyph As Variant
Dim i As Long, j As Long
Dim lPrefix As Long, lStart As Long, lEnd As Long
Dim sInput As String
Dim dc As Scripting.Dictionary
Set dc = New Scripting.Dictionary
vaComma = Split(sNumbers, ",")
For i = LBound(vaComma) To UBound(vaComma)
sInput = Trim$(vaComma(i))
If InStr(1, sInput, "-") > 0 Then
vaHyph = Split(sInput, "-")
'If you get a full one, keep the first three
If Len(vaHyph(0)) = 6 Then lPrefix = Val(Left$(sInput, 3)) * 1000
'Add the prefix if needed
lStart = Val(vaHyph(0))
If lStart < 1000 Then lStart = lPrefix + lStart
lEnd = Val(vaHyph(1))
If lEnd < 1000 Then lEnd = lPrefix + lEnd
Else
If Len(sInput) = 6 Then lPrefix = Val(Left$(sInput, 3)) * 1000
lStart = Val(sInput)
If lStart < 1000 Then lStart = lPrefix + lStart
lEnd = lStart
End If
'Generate the list
For j = lStart To lEnd
dc.Add j, j
Next j
Next i
Sheet1.Range("a1").Resize(dc.Count, 1).Value = Application.Transpose(dc.Items)
End Sub

Answer 3

try this:
Function trlMyString(myString As String) As String
On Error GoTo trlMyStringError
Dim i As Integer
Dim j As Integer
Dim helpArray() As String
Dim strg As String
Dim label1 As String
Dim label2 As String
strg = ""
helpArray() = Split(myString, ", ")
For i = LBound(helpArray) To UBound(helpArray)
If Len(helpArray(i)) > 3 And InStr(1, helpArray(i), "-") <> 4 Then
label1 = Left$(helpArray(i), 3)
helpArray(i) = Right$(helpArray(i), Len(helpArray(i)) - 3)
End If
If InStr(1, helpArray(i), "-") > 0 Then
For j = CInt(Left$(helpArray(i), 3)) To CInt(Right$(helpArray(i), 3))
'Debug.Print CInt(Left$(helpArray(i), 3)), CInt(Right$(helpArray(i), 3))
label2 = Trim$(Str$(j))
strg = strg & label1 & label2 & ", "
Next j
Else
label2 = helpArray(i)
strg = strg & label1 & label2 & ", "
End If
Next i
'Debug.Print strg
trlMyStringExit:
trlMyString = strg
Exit Function
trlMyStringError:
Resume trlMyStringExit
End Function