Excel-VBA splitting a string and storing the result into separate arrays

Question

I have many strings in the format Topic/Subtopic . I need to separate both of them and store the results of topic and subtopic into different arrays.

My code is:

Dim strText() As String
Dim seperate As Variant

i = QB_StartCell '4

ReDim strText(1 To 25)

'collecting all the types in an array
Do While Worksheets("QB").Cells(i, QB_Thema).Value <> ""  'QB_Thema is a column number
    strText(i) = Worksheets("QB").Cells(i, QB_Thema).Value
    MsgBox strText(i)
    i = i + 1
Loop

noThema = i - QB_StartCell

'splitting all the types into 2 parts
Do
    
seperate = Split(strText(p), "/")

Loop Until p > noThema

Now I want both the splitted parts in separate Arrays as I want to access them later. Any help?

sepearate(0) will give you the Topic and sepearate(1) will give you the Subtopic also in the last Do Loop you are not incrementing or decrementing the p — Stupid_Intern
– Stupid_Intern, Commented Apr 11, 2016 at 10:43

Thomas G · Accepted Answer · 2016-04-11 11:15:32Z

1

2 solutions : one 2D array or two 1D array

Dim arr_Multi(noThema, 2) As String
Dim arr_Topic(noThema) As String
Dim arr_SubTopic(noThema) As String

Do
    seperate = Split(strText(p), "/")

    ' Choose either storage in one 2D array
        arr_Multi(p, 0) = seperate(0)
        arr_Multi(p, 1) = seperate(1)

    ' or storage in two 1D arrays
        arr_Topic(p) = seperate(0)
        arr_SubTopic(p) = seperate(1)

    p = p + 1 ' and don't forget to increment your counter in the loop

Loop Until p > noThema

If you need your array(s) outside the sub, then you should declare them like this on top of your module:

Dim arr_Multi(1, 2) As String
Dim arr_Topic(1) As String
Dim arr_SubTopic(1) As String

And in your loop you do a redim preserve of your array(s) before incrementing p:

' Either
redim preserve arr_Multi(p, 2)

'or 
redim preserve arr_Topic(p)
redim preserve arr_SubTopic(p)

answered Apr 11, 2016 at 11:15

Thomas G

10.3k7 gold badges33 silver badges45 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

Nikky Over a year ago

It gives an error Subscript out of range at line arr_Topic(p) = seperate(0). I guess it is due to the dimensioning of Arrays. I have mentioned redim preserve as well.

Thomas G Over a year ago

This is because your seperate = Split(strText(p), "/") doesnt return an array probably due to the fact that strText(p) is empty or not containing any /. We don't know your data. You have to adapt the code to match it.

Nikky Over a year ago

HI, Thanks for your suggestions. Yes you were write. After coming out from the loop strText(p) becomes empty. I cannot understand why. Inside the Loop it Shows the value when i print it but outside it becomes empty.

Nikky Over a year ago

Got my mistake. Array was going out of bounds.

halfer · Accepted Answer · 2016-04-11 13:51:33Z

There's no need to iterate twice, first through cells and then through array.

You can make it in one iteration like this:

Option Explicit

Sub main()
Dim i As Long, lastRow As Long, nonBlankCellsNumber As Long
Dim QB_Thema As Long, QB_StartCell As Long
Dim cell As Range
Dim topicArr() As String, subTopicArr() As String

QB_Thema = 3 'added this for my test
QB_StartCell = 4

lastRow = GetLastRow(Worksheets("QB"), QB_Thema, "F", QB_StartCell) '<== I assumed as per your code that you stop at the first occurrence of a blank cell. should you want to process all non blank data to the last non blank cell, then use "L" as the 3rd argument of this call
If lastRow = -1 Then Exit Sub

With Worksheets("QB")
    With .Range(.Cells(QB_StartCell, QB_Thema), .Cells(lastRow, QB_Thema))
        nonBlankCellsNumber = WorksheetFunction.CountA(.Cells)
        ReDim topicArr(1 To nonBlankCellsNumber)
        ReDim subTopicArr(1 To nonBlankCellsNumber)
        i = 0
        For Each cell In .Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
            i = i + 1
            topicArr(i) = Split(cell.value, "/")(0)
            subTopicArr(i) = Split(cell.value, "/")(1)
        Next cell
    End With
End With

End Sub


Function GetLastRow(sht As Worksheet, columnIndex As Long, FirstOrLastBlank As String, Optional firstRow As Variant) As Long
If IsMissing(firstRow) Then firstRow = 1
With sht
    If FirstOrLastBlank = "F" Then
        With .Cells(firstRow, columnIndex)
            If .value = "" Then
                GetLastRow = .End(xlDown).End(xlDown).row
            Else
                GetLastRow = .End(xlDown).row
            End If
        End With
        If GetLastRow = .Rows.count And .Cells(GetLastRow, columnIndex) = "" Then GetLastRow = firstRow
    ElseIf FirstOrLastBlank = "F" Then
        GetLastRow = .Cells(.Rows.count, columnIndex).End(xlUp).row
        If GetLastRow < firstRow Then GetLastRow = firstRow
    Else
        MsgBox "invalid 'FirstOrLastBlank' parameter"
        GetLastRow = -1
    End If
End With
End Function

As you see I also posted Function GetLastRow() to get the last row index of data to scan.

As per your code I got you want to start at row 4 and stop at the first blank cell (excluded), and so I tuned the arguments (namely the 3rd one: "F") in the call to GetLastRow accordingly.

Instead, should you want to scan all non-blank cells in the given column, then you may call the same GetLastRow function passing "L" as 3rd parameter.

Collectives™ on Stack Overflow

Excel-VBA splitting a string and storing the result into separate arrays

2 Answers 2

4 Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

4 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related