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

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)

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.
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.
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.

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

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

4 Comments

Comments

Related