Macro help to include alphanumericalpha with available code

[ukbulldog001]

Sub ReArrangeData()
With Range("B1:B" & Range("A" & Rows.Count).End(xlUp).Row)
  .FormulaR1C1 = "=ExpandedSeries(RC[-1])"
  .Value = .Value
End With
Columns(2).AutoFit
End Sub
Function ExpandedSeries(ByVal S As String) As String
Dim X As Long, Z As Long
Dim Letter As String, NumberLeft As String, NumberRight As String, Parts() As String
S = Replace(Replace(Application.Trim(Replace(S, ",", " ")), " -", "-"), "- ", "-")
Parts = Split(S)
For X = 0 To UBound(Parts)
  If Parts(X) Like "*-*" Then
    For Z = 1 To InStr(Parts(X), "-") - 1
      If IsNumeric(Mid(Parts(X), Z, 1)) Then
        Letter = Left(Parts(X), Z + (Left(Parts(X), 1) Like "[A-Za-z]"))
        If IsNumeric(Letter) Then Letter = ""
        NumberLeft = Mid(Left(Parts(X), InStr(Parts(X), "-") - 1), Z, 99)
        NumberRight = Replace(Mid(Parts(X), InStr(Parts(X), "-") + 1), Letter, "")
        Exit For
      End If
    Next
    For Z = NumberLeft To NumberRight
      ExpandedSeries = ExpandedSeries & ", " & Letter & Z
    Next
  Else
    ExpandedSeries = ExpandedSeries & ", " & Parts(X)
  End If
Next
ExpandedSeries = Mid(ExpandedSeries, 3)
End Function

the above code works well if the character are just alphanumeric.
Ex: A1-A5 = A1, A2, A3, A4, A5
BGA00-BGA03 = BGA0, BGA1, BGA2, BGA3

have below two issues...
not considering "C02ENT00-C02ENT02" which should give output as C02ENT00, C02ENT01, C02ENT02
and as stated above "BGA00-BGA03" should give output as BGA00, BGA01, BGA02, BGA03

let me know if this is possible or any workaround.
Thanks.

 

[Akuini]

@ukbulldog001
Here's my attempt.
It's not a function, but if it works as expected you can turn it into a function.

Sub ukbulldog001()
Dim i As Long, x As Long, n As Long
Dim a As String, b As String, aa As String, bb As String, cc As String, txA As String
Dim ary, q
For Each q In Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
    ary = Split(q, "-")
    a = StrReverse(ary(0))  'e.g.  C02ENT00 becomes 00TNE20C
    b = StrReverse(ary(1))
    n = Len(a)
           For i = 1 To n
                If a Like String(i, "#") & "[A-Z]*" Then Exit For
           Next
    x = i
    aa = Right(ary(0), x)
    bb = Right(ary(1), x)
    cc = Left(ary(0), Len(ary(0)) - x)
    txA = Empty
    For i = aa To bb
        txA = txA & ", " & cc & Format(i, String(x, "0"))
    Next
    Debug.Print Mid(txA, 3)
Next

End Sub

Book1
	A
1	C02ENT00-C02ENT02
2	A1-A5
3	BGA00-BGA03
Sheet2

Result in immediate window:
C02ENT00, C02ENT01, C02ENT02
A1, A2, A3, A4, A5
BGA00, BGA01, BGA02, BGA03

 

[Akuini]

I think my previous code is a bit complicated, here's a simpler one:

Sub ukbulldog001_2()
Dim i As Long, x As Long, n As Long
Dim a As String, b As String, aa As String, bb As String, cc As String, txA As String
Dim ary, q
For Each q In Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
    ary = Split(q, "-")
        x = 0
        For i = Len(ary(0)) To 1 Step -1
            If Not IsNumeric(Mid(ary(0), i, 1)) Then Exit For
            x = x + 1
        Next

    aa = Right(ary(0), x)
    bb = Right(ary(1), x)
    cc = Left(ary(0), Len(ary(0)) - x)
    txA = Empty
    For i = aa To bb
        txA = txA & ", " & cc & Format(i, String(x, "0"))
    Next
    Debug.Print Mid(txA, 3)
Next

End Sub

 

[Bosquedeguate]

Try this modified code for the ExpandedSeries function/
I tried it on three test cases:
?ExpandedSeries("C02ENT00-C02ENT02")
C02ENT00, C02ENT01, C02ENT02
?ExpandedSeries("BGA00-BGA03")
BGA00, BGA01, BGA02, BGA03
?ExpandedSeries("A1-A5")
A1, A2, A3, A4, A5

Function ExpandedSeries(ByVal S As String) As String
Dim X As Long, Z As Long, Y As Long, Hyphen As Long
Dim Letter As String, NumberLeft, NumberRight, Parts() As String


S = Replace(Replace(Trim(Replace(S, ",", " ")), " -", "-"), "- ", "-")
'S = Replace(S, ",", " ")

Parts = Split(S)
For X = 0 To UBound(Parts)
  If Parts(X) Like "*-*" Then
    Hyphen = InStr(Parts(X), "-")
    
    For Y = 1 To Hyphen - 1
      If Not IsNumeric(Mid(Parts(X), Hyphen - Y, Y)) Then Exit For
    Next Y
    
    Y = Y - 1
    If Y > 0 Then
      Letter = Left(Parts(X), Hyphen - Y - 1)
      If IsNumeric(Letter) Then Letter = ""
      NumberLeft = Mid(Parts(X), Hyphen - Y, Y)
      NumberRight = Replace(Mid(Parts(X), Hyphen + 1), Letter, "")
    End If
    
    For Z = NumberLeft To NumberRight
      ExpandedSeries = ExpandedSeries & ", " & Letter & Format(Z, Left("000000", Y))
    Next
  Else
    ExpandedSeries = ExpandedSeries & ", " & Parts(X)
  End If
Next
ExpandedSeries = Mid(ExpandedSeries, 3)
End Function

 

[Bosquedeguate]

I think my previous code is a bit complicated, here's a simpler one:

Sub ukbulldog001_2()
Dim i As Long, x As Long, n As Long
Dim a As String, b As String, aa As String, bb As String, cc As String, txA As String
Dim ary, q
For Each q In Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
    ary = Split(q, "-")
        x = 0
        For i = Len(ary(0)) To 1 Step -1
            If Not IsNumeric(Mid(ary(0), i, 1)) Then Exit For
            x = x + 1
        Next

    aa = Right(ary(0), x)
    bb = Right(ary(1), x)
    cc = Left(ary(0), Len(ary(0)) - x)
    txA = Empty
    For i = aa To bb
        txA = txA & ", " & cc & Format(i, String(x, "0"))
    Next
    Debug.Print Mid(txA, 3)
Next

End Sub

Here is a function version of Akuini's code. I added the check for a list that is delimited with commas or spaces

Function EX2(str As String) As String
  Dim i As Long, x As Long, n As Long
  Dim a As String, b As String, aa As String, bb As String, cc As String, txA As String
  Dim ary
  Dim q As String


  q = Trim(Replace(Replace(str, " ", ""), ",", ", "))
  EX2 = q
  ary = Split(q, "-")
  x = 0
  If UBound(ary) < 1 Then Exit Function
  
  For i = Len(ary(0)) To 1 Step -1
      If Not IsNumeric(Mid(ary(0), i, 1)) Then Exit For
      x = x + 1
  Next

  aa = Right(ary(0), x)
  bb = Right(ary(1), x)
  cc = Left(ary(0), Len(ary(0)) - x)
  txA = Empty
  For i = aa To bb
      txA = txA & ", " & cc & Format(i, String(x, "0"))
  Next

  EX2 = Mid(txA, 3)
End Function

 

[ukbulldog001]

Try this modified code for the ExpandedSeries function/
I tried it on three test cases:
?ExpandedSeries("C02ENT00-C02ENT02")
C02ENT00, C02ENT01, C02ENT02
?ExpandedSeries("BGA00-BGA03")
BGA00, BGA01, BGA02, BGA03
?ExpandedSeries("A1-A5")
A1, A2, A3, A4, A5

Function ExpandedSeries(ByVal S As String) As String
Dim X As Long, Z As Long, Y As Long, Hyphen As Long
Dim Letter As String, NumberLeft, NumberRight, Parts() As String


S = Replace(Replace(Trim(Replace(S, ",", " ")), " -", "-"), "- ", "-")
'S = Replace(S, ",", " ")

Parts = Split(S)
For X = 0 To UBound(Parts)
  If Parts(X) Like "*-*" Then
    Hyphen = InStr(Parts(X), "-")
   
    For Y = 1 To Hyphen - 1
      If Not IsNumeric(Mid(Parts(X), Hyphen - Y, Y)) Then Exit For
    Next Y
   
    Y = Y - 1
    If Y > 0 Then
      Letter = Left(Parts(X), Hyphen - Y - 1)
      If IsNumeric(Letter) Then Letter = ""
      NumberLeft = Mid(Parts(X), Hyphen - Y, Y)
      NumberRight = Replace(Mid(Parts(X), Hyphen + 1), Letter, "")
    End If
   
    For Z = NumberLeft To NumberRight
      ExpandedSeries = ExpandedSeries & ", " & Letter & Format(Z, Left("000000", Y))
    Next
  Else
    ExpandedSeries = ExpandedSeries & ", " & Parts(X)
  End If
Next
ExpandedSeries = Mid(ExpandedSeries, 3)
End Function

Sorry, I did forgot to mention 1 more case. as below.
E12, E15, E27-E33 = E12, E15, E27, E28, E29, E30, E31, E32, E33
but using the above code gives me "E12, , E15, , E27, E28, E29, E30, E31, E32, E33" with double comma space.

 

[Bosquedeguate]

This function seems to work

Function ExpandedSeries(ByVal S As String) As String
Dim x As Long, Z As Long, Y As Long, Hyphen As Long
Dim Letter As String, NumberLeft, NumberRight, Parts() As String


S = Trim(Replace(Replace(S, " ", ""), ",", " "))
'S = Replace(S, ",", " ")

Parts = Split(S)
For x = 0 To UBound(Parts)
  If Parts(x) Like "*-*" Then
    Hyphen = InStr(Parts(x), "-")
    
    For Y = 1 To Hyphen - 1
      If Not IsNumeric(Mid(Parts(x), Hyphen - Y, Y)) Then Exit For
    Next Y
    
    Y = Y - 1
    If Y > 0 Then
      Letter = Left(Parts(x), Hyphen - Y - 1)
      If IsNumeric(Letter) Then Letter = ""
      NumberLeft = Mid(Parts(x), Hyphen - Y, Y)
      NumberRight = Replace(Mid(Parts(x), Hyphen + 1), Letter, "")
    End If
    
    For Z = NumberLeft To NumberRight
      ExpandedSeries = ExpandedSeries & ", " & Letter & Format(Z, Left("000000", Y))
    Next
  Else
    ExpandedSeries = ExpandedSeries & ", " & Parts(x)
  End If
Next
ExpandedSeries = Mid(ExpandedSeries, 3)
End Function

 

[Bosquedeguate]

Here is a revised version of Akuini's code that also works (after a few modifications).

Function EX3(str As String) As String

  Dim i As Long, x As Long, n As Long
  Dim a As String, b As String, aa As String, bb As String, cc As String, txA As String
  Dim ary, tmp
  
  tmp = Split(Replace(str, " ", ""), ",")
  txA = Empty
  For r = 0 To UBound(tmp)
    If (InStr(tmp(r), "-") > 0) Then
      ary = Split(tmp(r), "-")
      x = 0
      For i = Len(ary(0)) To 1 Step -1
          If Not IsNumeric(Mid(ary(0), i, 1)) Then Exit For
          x = x + 1
      Next
  
      aa = Right(ary(0), x)
      bb = Right(ary(1), x)
      cc = Left(ary(0), Len(ary(0)) - x)
      For i = aa To bb
        txA = txA & "," & cc & Format(i, String(x, "0"))
      Next
      
    Else
      txA = txA & "," & tmp(r)
    End If
  Next
    
  EX3 = Mid(txA, 2)

End Function