Splitting array values into the correct column

Question

Need some help on sorting the values into the correct column. I can't seem to figure out how I would return the array values to the proper column in the table.

For the output into column B "Pipe DN" it should return the first split text from the values in "Line number", and for the "Service" column F it should return the 2nd split text from "Line number".

How would I accomplish this? - If for "Pipe DN" I use Range("B19", Range("B19").Offset(Dimension1 - 1, 1)).Value = StrArray, it will return me the correct values, but the "Service" code is not written on the correct column.

Sub SplitLinesIntoArray()
    
    Dim LineNumber() As Variant
    Dim StrArray() As Variant
    Dim Dimension1 As Long, Counter As Long
    
    LineNumber = Range("J19", Range("J19").End(xlDown))
    
    Dimension1 = UBound(LineNumber, 1)
    
    ReDim StrArray(1 To Dimension1, 1 To 2)
    
    For Counter = 1 To Dimension1
        'Pipe DN
        StrArray(Counter, 1) = Split(LineNumber(Counter, 1), "-")(0)
        Range("B19", Range("B19").Offset(Dimension1 - 1, 0)).Value = StrArray
        'Service Code
        StrArray(Counter, 2) = Split(LineNumber(Counter, 1), "-")(1)
        Range("F19", Range("F19").Offset(Dimension1 - 1, 0)).Value = StrArray(Counter, 2)
    Next Counter
    
    'Range("B19", Range("B19").Offset(Dimension1 - 1, 1)).Value = StrArray
    Erase LineNumber
    Erase StrArray
    
 End Sub

Answer 1

Basically you start well by analyzing a 2-dim datafield array and assigning resulting string manipulations (Split()) to it.

Results seem to (1) output correctly as for the first array "column" ("Pipe DN", starting in cell B19), whereas (2) the second column ("Service", F19) repeats the result of the very last split action for each array "row".

This impression has to be qualified:

• ad 1) You are doing unnecessary extra work by assigning the entire StrArray to the entire "Pipe DN" column, repeating this action with each single row iteration. (Note that the StrArray gets only completely filled with the last loop).
• ad 2) Basically you assign again with each iteration, but this time you get only the latest split result and fill the entire "Service" column with the latest result assigned to StrArray(Counter,2). Eventually all items show the last split result instead of the individual LineNumber splittings.

See this abbreviated example for three example items only to understand what is happening (this SnapShot shows the table results when code is stopped after the 2nd iteration (i.e. after Counter=2):

Immediate help

Sticking to your initial code, I'd omit

• Range("B19", Range("B19").Offset(Dimension1 - 1, 0)).Value = StrArray as well as
• Range("F19", Range("F19").Offset(Dimension1 - 1, 0)).Value = StrArray(Counter, 2)

within the For..Next loop, but add the following two code lines thereafter:

• Range("B19", Range("B19").Offset(Dimension1 - 1, 0)).Value = Application.Index(StrArray, 0, 1)
• Range("F19", Range("F19").Offset(Dimension1 - 1, 0)).Value = Application.Index(StrArray, 0, 2)

in order to slice the StrArray into columns and write each column separately to your cell target.

Further note:

Fully qualify your range references to prevent possibly unwanted results as Excel would take the currently active sheet if not referenced explicitly ... and this need not be the targeted one :-;

Using VBA, it's not necessary in standard office situations to clear (Erase) at the end of a procedure to free memory.

---

Possible alternative avoiding array slicing

You might profit from the the following code, which

• fully qualifies your range references (note: unqualified refs invite Excel to take the currently active sheet without request),
• uses a jagged array (aka as Array of Arrays) to avoid (multiple) column slicing (as needed in OP)
• demonstrates the use of Private Constants on module top (used here for enumerating the sub-arrays within the jagged array
• demonstrates a help procedure to provide for a correcty dimensioned jagged array:

Example code

Option Explicit                     ' declaration head of code module (forching variable declarations)

Private Const LineNum As Long = 0   ' enumerate sub-arrays within jagged array 
Private Const Pipe    As Long = 1
Private Const Service As Long = 2

Sub SplitLinesIntoJaggedArray()
'I. Set Worksheet object to memory               ' fully qualify any range references!
    Dim ws As Worksheet                          ' declare ws as of worksheet object type
    Set ws = Tabelle1                            ' << use the project's sheet Code(Name)
    'set ws = ThisWorkbook.Worksheets("Sheet1")  ' or: via a sheet's tabular name (needn't be the same)

With ws                                          ' With .. End With structure, note the following "."-prefixes
'II.Definitions
'a) assign target start cell addresses to array tgt
    Dim tgt As Variant
    tgt = Split("J19,B19,F19", ",")              ' split requires "Dim tgt" without brackets to avoid Error 13
'b) define source range object and set to memory
'   Note: tgt(LinNum) equalling tgt(0) equalling "J19"
    Dim src As Range
    Set src = .Range(tgt(LineNum), .Range(tgt(0)).End(xlDown))   ' showing both enumerations only for demo:-)
    Dim CountOfRows As Long: CountOfRows = src.Rows.Count        ' count rows in source range
'c) provide for a correctly dimensioned jagged array to hold all 2-dim data arrays (three columns)
    Dim JaggedArray() As Variant
    BuildJagged JaggedArray, CountOfRows     ' << call help procedure BuildJaggedArray

'III.Assign column data to JaggedArray
'a) assign LineNum column as 2-dim datafield to JaggedArray(LineNum)
    JaggedArray(LineNum) = src.Value
'b) assign LineNum splits to JaggedArray(Pipe) and JaggedArray(Service)
    Dim Counter As Long
    For Counter = 1 To CountOfRows
    '1. Pipe DN
        JaggedArray(Pipe)(Counter, 1) = Split(JaggedArray(LineNum)(Counter, 1), "-")(0)
    '2. Service Code
        JaggedArray(Service)(Counter, 1) = Split(JaggedArray(LineNum)(Counter, 1), "-")(1)
    Next Counter
        
'IV.Write result columns of jagged array to target addresses
'   Note: tgt(Pipe)=tgt(1)="B19", tgt(Service)=tgt(2)="F19"
    Dim elem As Long
    For elem = Pipe To Service
        .Range(tgt(elem)).Resize(CountOfRows, 1) = JaggedArray(elem)
    Next

End With
End Sub

*Help procedure BuildJagged

Note that the first procedure argument passes the jagged array By Reference (=default, if not explicitly passed ByVal). This means that any further actions within the help procedure have an immediate effect on the original array.

Sub BuildJagged(ByRef JaggedArray, ByVal CountOfRows As Long)
'Purpose: provide for correct dimensions of the jagged array passed By Reference
        ReDim JaggedArray(LineNum To Service)   ' include LineNum as data base (gets dimmed later)
        Dim tmp() As Variant
        ReDim tmp(1 To CountOfRows, 1 To 1)
        Dim i As Long
        For i = Pipe To Service                 ' suffices here to start from 1=Pipe to 2=Service
            JaggedArray(i) = tmp
        Next i
End Sub

Further link

Error in finding last used cell in Excel VBA