Write out specific ranges in excel

Question

i have the following problem:

I have several values like ABD and then at the end i have (0-9; A-Z) defining the range. So if you write it out it's ABD0; ABD1;... ABDY; ABDZ.

I have two table structures:

How can i write out the ranges for both table structures (view them as separate) with formula or VBA code? SO that i have all the ranges written out like ABD0; ABD1;... ABDY; ABDZ.

Thanks in advance.

Updated Picture:

Next Picture:

Update 3:

Answer 1

Disposing of Excel/MS 365 and the new TextSplit() function you might profit from the following blockwise calculation of array results.

Note that I assumed the entire code inputs in column A only - it would be relatively easy, however to change the procedure also for the case of code inputs in two separate columns A:B as mentioned by Dani as further possible input option.

Sub TxtSplit()
    Const colOffset As Long = 3             ' column offset for target
    Const colCount  As Long = 36            ' 10 nums + 26 chars = 36
    With Sheet1                     ' << change to wanted Project's sheet Code(Name)
    '1. define data range containing codes      ' e.g. "ABD(0-3;M-N)", etc.
        Dim lastrow As Long
        lastrow = .Range("A" & Rows.Count).End(xlUp).Row
        Dim rng As Range
        Set rng = .Range("A2:A" & lastrow)  ' << define start row as needed
    '2. get codes
        Dim codes: codes = rng.Value        ' variant 1-based 2-dim datafield array
    '3. clear target (e.g. 3 columns to the right)
        rng.Offset(, colOffset).Resize(, colCount) = vbNullString
    '4. calculate results and write them to range offset
        Dim i As Long
        For i = 1 To UBound(codes)           ' << Loop
        'a) get definitions elements
            Dim defs                             ' 1   2 3 4 5
            defs = getDefs(codes(i, 1))          ' ABD|0|3|M|N|
        'b) get array elements with numeric and character suffixes
            Dim num:  num = getNum(defs)
            Dim char: char = getChars(defs)
        'c) write results to target (e.g. 3 columns to the right)
            With rng.Cells(1, 1).Offset(i - 1, colOffset)
                .Resize(1, UBound(num)) = num
                .Offset(, UBound(num)).Resize(1, UBound(char)) = char
            End With
        Next i
    End With
End Sub

Help functions

• getNums()... calculating the items with numeric suffixes using a Sequence() evaluation
• getChars().. calculating the items with character suffixes using a Sequence() evaluation
• getDefs()... tokenizing the code inputs via a TextSplit() evaluation (based on an array of delimiters)
• col()....... getting column numbers out of character inputs

Function getNum(x, Optional ByVal myFormula As String = "")
    myFormula = _
        """" & x(1) & """ &" & _
        "Sequence(" & Join(Array(1, x(3) - x(2) + 1, x(2)), ",") & ")"
    getNum = Evaluate(myFormula)
End Function

Function getChars(x, Optional ByVal myFormula As String = "")
    myFormula = _
        """" & x(1) & """ & " & _
        "Char(" & "Sequence(" & Join(Array(1, x(5) - x(4) + 1, x(4)), ",") & ")" & "+64)"
    getChars = Evaluate(myFormula)
End Function

Function getDefs(ByVal code As String, Optional ByVal myFormula As String = "")
'Purp: tokenize code string, e.g. ABD(0-3;M-N) ~~> ABD|0|3|M|N|
'a) split code into tokens (via array of delimiters)
    myFormula = "=TEXTSplit(""" & code & """,{""("","";"",""-"","")""})"
    Dim tmp: tmp = Evaluate(myFormula)          ' e.g. ABD|0|3|M|N|
'b) change column characters into numeric values
    Dim i As Long
    For i = 4 To 5: tmp(i) = col(tmp(i)): Next  ' col chars to nums
'c) return definitions
    getDefs = tmp
End Function

Function col(ByVal colChar As String) As Long
'Purp:  change column character to number
    col = Range(colChar & 1).Column
End Function

Answer 2

Try this:

=LET(C,A2,D,TEXTSPLIT(SUBSTITUTE(SUBSTITUTE(TEXTAFTER(C,"("),")",""),"-",";"),";"),T,TEXTBEFORE(C,"("),VSTACK(T&CHAR(ROW(INDIRECT(CODE(INDEX(D,1))&":"&CODE(INDEX(D,2))))),IFERROR(T&CHAR(ROW(INDIRECT(CODE(INDEX(D,3))&":"&CODE(INDEX(D,4))))),"")))

Change A2 with your cell reference

edit modified to include more than 1 digit and more than 1 alphabetic char

=LET(C,A2,D,TEXTSPLIT(SUBSTITUTE(SUBSTITUTE(TEXTAFTER(C,"("),")",""),"-",";"),";"),T,TEXTBEFORE(C,"("),VSTACK(T&SEQUENCE(INDEX(D,2)-INDEX(D,1)+1,1,INDEX(D,1)),T&IFERROR(SUBSTITUTE(ADDRESS(1,SEQUENCE(COLUMN(INDIRECT(INDEX(D,4)&"1"))-COLUMN(INDIRECT(INDEX(D,3)&"1"))+1,1,COLUMN(INDIRECT(INDEX(D,3)&"1"))),4),"1",""),"")))

I've seen your new request and this is to expand horizontally from two cells

=LET(C,SUBSTITUTE(A2&B2;" ";""),D,TEXTSPLIT(SUBSTITUTE(SUBSTITUTE(TEXTAFTER(C,"("),")",""),"-",";"),";"),T,TEXTBEFORE(C,"("),TRANSPOSE(VSTACK(T&SEQUENCE(INDEX(D,2)-INDEX(D,1)+1,1,INDEX(D,1)),T&IFERROR(SUBSTITUTE(ADDRESS(1,SEQUENCE(COLUMN(INDIRECT(INDEX(D,4)&"1"))-COLUMN(INDIRECT(INDEX(D,3)&"1"))+1,1,COLUMN(INDIRECT(INDEX(D,3)&"1"))),4),"1",""),""))))

Answer 3

Please, try the next VBA code:

Sub WriteRangeSeries()
  Dim x As String, strPref As String, strCond As String, arrCond, strRow As String, strCol As String
  Dim arrRow, arrCol, arrNumb() As String, arrLetters() As String, arrRng() As String, bool0 As Boolean
  
    x = "ABD(0-11;A-Z)"
    strPref = left(x, InStr(x, "(") - 1) 'extract prefix before "(" - ABD, in this case
    strCond = Mid(x, Len(strPref) + 2)
    strCond = left(strCond, Len(strCond) - 1)           'extract conditions to be processed (numbers and letters ranges)
    arrCond = Split(Replace(strCond, " ", ""), ";")  'just for the case of spaces existing as: 0 - 11;A-Z, 0-11; A-Z, 0-11;A- Z
    arrRow = Split(arrCond(0), "-"): If arrRow(0) = "0" Then arrRow(0) = "1": bool0 = True 'replace 0 with 1 in case of its existing as the first digit
     strRow = Join(arrRow, ":") 'create the string to be evaluated as transposed rows
      
    arrCol = Split(arrCond(1), "-"): arrCol(0) = Asc(arrCol(0)): arrCol(1) = Asc(arrCol(1))
      strCol = Join(arrCol, ":")
    
    arrNumb = Split(strPref & Join(Evaluate("TRANSPOSE(ROW(" & strRow & ")-" & IIf(bool0, 1, 0) & ")"), "|" & strPref), "|")
    Debug.Print Join(arrNumb, "|") 'just to visually see the joined created array
   
    arrLetters = Split(strPref & Join(Evaluate("CHAR(TRANSPOSE(ROW(" & strCol & ")))"), "|" & strPref), "|")
    Debug.Print Join(arrLetters, "|") 'just to visually see the joined created array
    arrRng = Split(Join(arrNumb, "|") & "|" & Join(arrLetters, "|"), "|")

    'drop the built array content, starting from "A2". You can choose this cell as you need/wont:
    Range("A2").Resize(1, UBound(arrRng) + 1).Value2 = arrRng
End Sub

Dis is the didactic approach, a little easier to be understood...

You can use it as a function:

Function createRangeArr(x As String) As String()
  Dim strPref As String, strCond As String, arrCond, strRow As String, strCol As String
  Dim arrRow, arrCol, arrNumb() As String, arrLetters() As String, arrRng() As String, bool0 As Boolean
  
    
    strPref = left(x, InStr(x, "(") - 1) 'extract prefix before "(" - ABD, in this case
    strCond = Mid(x, Len(strPref) + 2)
    strCond = left(strCond, Len(strCond) - 1)           'extract conditions to be processed (numbers and letters ranges)
    arrCond = Split(Replace(strCond, " ", ""), ";")  'just for the case of spaces existing as: 0 - 11;A-Z, 0-11; A-Z, 0-11;A- Z
    arrRow = Split(arrCond(0), "-"): If arrRow(0) = "0" Then arrRow(0) = "1": bool0 = True 'replace 0 with 1 in case of its existing as the first digit
     strRow = Join(arrRow, ":") 'create the string to be evaluated as transposed rows
      
    arrCol = Split(arrCond(1), "-"): arrCol(0) = Asc(arrCol(0)): arrCol(1) = Asc(arrCol(1)) 'replace the letters with their ASCII value
      strCol = Join(arrCol, ":")   'create the string to be evaluated
      
    'create the array involving numbers:
    arrNumb = Split(strPref & Join(Evaluate("TRANSPOSE(ROW(" & strRow & ")-" & IIf(bool0, 1, 0) & ")"), "|" & strPref), "|")
    'create the array involving letters:
    arrLetters = Split(strPref & Join(Evaluate("CHAR(TRANSPOSE(ROW(" & strCol & ")))"), "|" & strPref), "|")
    
    createRangeArr = Split(Join(arrNumb, "|") & "|" & Join(arrLetters, "|"), "|") 'make the array by splitting the above joined arrays
End Function

And can be used in the next way:

Sub testCreateRange()
    Dim x As String, arrRng() As String, rngFirstCell As Range
    
    x = "ABD(0-11;A-Z)"
    Set rngFirstCell = Range("A2")
    arrRng = createRangeArr(x)
    rngFirstCell.Resize(1, UBound(arrRng) + 1).Value2 = arrRng
End Sub

Or using it as UDF, placing the next formula in a cell:

  =createRangeArr(A1)

Of course, in A1 (or somewhere else) must be the string to be evaluated (ABD(0-11;A-Z))...

Edited:

In order to build the string to be evaluated from two cells value, you can simple use (as UDF) formula:

   =createRangeArr(A1&A2)

Of course, A1 and A2 will keep partial strings to build the necesssary one...

And in case of calling the function from VBA, you can use:

   arrRng = createRangeArr(Range("A1").value & Range("A2").value)