VBA - Conditionally populate array from existing array - arrays

Question

I'm creating an array from a text file and want to create a "subarray" from the main one.
The main array has the form
And I want to extract the A and B.
I create the "sub array" by splitting the strings from each row
For n = LBound(MainArray) To UBound(MainArray)
If Split(MainArray(n), " ")(0) = "Data" Then
ReDim SubArray(X)
SubArray(X) = Split(MainArray(n), " ")(1)
X = X + 1
End If
Next n
but doing this just returns the array (written as a vector now) (" ", B).
Why does A get overwritten by an empty space after the for loop finds the B?
Thanks and Happy Easter!
Note the example above is just a minimalist version of the real array.

Answer 1

This answer is predicated on Main array being a single dimension array.
The problem you are having is that you are nott creating new sub arrays each time tou get a new 'Data xxx" and consequently just keep overwriting the previous subarray.
You will be better served in you endeavour by using a dictionary of dictionaries.
To use dictionaries you either have to add a reference to the Microsoft Scripting Runtime or use 'CreateObject("Scripting.Dicitonary"). The first option is preferred when developing code or when you are a newbie because you get intellisense. You don't get intellisense when you use late bound objects (created by CreateObject).
Scripting.Dictionaries should be preferred over collections with keys because Dictionaries allow you to retreive the Keys or Items as arrays in their own right.
Here is your code modified to use scripting Dictionaries
Dim myD As Scripting.Dictionary
Set myD = New Scripting.Dictionary
Dim mySubDName As String
mySubDName = "Unknown"
Dim myItem As Variant
For Each myItem In MainArray
If InStr(myItem, "Data") > 0 Then
mySubDName = Trim(myItem)
If Not myD.exists(SubDName) Then
' Create a new sub dictionary with key 'Data XXXX'
myD.Add mySubDName, New Scripting.Dictionary
End If
Else
Dim myArray As Variant
myArray = Split(Trim(myItem), " ")
myD.Item(mySubDName).Add myArray(0), myArray(1)
End If
Next
Dictionary myD will have Keys of "Data A", Data B" etc.
You retrieve a sub dictionary using
'Where XXXX is A,B,C etc
set mySubD = myD.Item("Data XXXX")
The sub dictionary has the structure (using 00000007 700 as an example) of Key=00000007 and Item = 700
If you enumerate a Dictionary using for each it returns the Key as the control variable.
You can get an array of the Keys using the .Keys method
you can Get an array of the Items using the .Items Method
E.g.
myD.Keys gives the array ("Data A", "Data B", "Data C", ....."Data XXX"
myD.Item("Data B").Items will give the array ("0000005", "0000006",.....,"00000010, etc"
Please do take the ttime to read up on Scripting.Dictionaries as part of understanding the above.
Good luck with your coding.

Answer 2

Since you do not answer the clarification questions, please try the next code, which processes a 2D array, resulting two 2D arrays, corresponding to 'Data A' and 'Data B':
Sub Split2DArray()
Dim MainArray, arrA, arrB, n As Long, iA As Long, iB As Long, boolFirst As Boolean
'for exemplification place the picture content in A:A column, then place it in a (2D) array:
MainArray = Range("A1:A13").value
ReDim arrA(1 To 1, 1 To UBound(MainArray)): iA = 1
ReDim arrB(1 To 1, 1 To UBound(MainArray)): iB = 1
For n = LBound(MainArray) To UBound(MainArray)
If MainArray(n, 1) <> "" Then
If Split(MainArray(n, 1), " ")(0) = "Data" Then
If Not boolFirst Then
boolFirst = True
arrA(1, iA) = MainArray(n, 1): iA = iA + 1
Else
boolFirst = False
arrB(1, iB) = MainArray(n, 1): iB = iB + 1
End If
ElseIf boolFirst Then
arrA(1, iA) = MainArray(n, 1): iA = iA + 1
Else
arrB(1, iB) = MainArray(n, 1): iB = iB + 1
End If
End If
Next n
If iA > 1 Then ReDim Preserve arrA(1 To 1, 1 To iA - 1) 'only the second dimension can be preserved
If iB > 1 Then ReDim Preserve arrB(1 To 1, 1 To iB - 1)
Range("C1").Resize(UBound(arrA, 2), 1).value = Application.Transpose(arrA)
Range("D1").Resize(UBound(arrB, 2), 1).value = Application.Transpose(arrB)
End Sub
The code can be easily adapted to process 1D arrays. If this is the case I can show you how to proceed. If many such 'Data x' slices exist, you should use a Dictionary keeping each array.
The same processing way for 1D arrays. Using the same visual elocvent way of testing:
Sub Split1DArray()
Dim MainArray, arrA, arrB, n As Long, iA As Long, iB As Long, boolFirst As Boolean
'for exemplification place the picture content in A:A column, then place it in a (2D) array:
MainArray = Application.Transpose(Range("A1:A13").value) 'obtaining a 1D array from the same reange...
ReDim arrA(1 To UBound(MainArray)): iA = 1
ReDim arrB(1 To UBound(MainArray)): iB = 1
For n = LBound(MainArray) To UBound(MainArray)
If MainArray(n) <> "" Then
If Split(MainArray(n), " ")(0) = "Data" Then
If Not boolFirst Then
boolFirst = True
arrA(iA) = MainArray(n): iA = iA + 1
Else
boolFirst = False
arrB(iB) = MainArray(n): iB = iB + 1
End If
ElseIf boolFirst Then
arrA(iA) = MainArray(n): iA = iA + 1
Else
arrB(iB) = MainArray(n): iB = iB + 1
End If
End If
Next n
If iA > 1 Then ReDim Preserve arrA(1 To iA - 1) 'only the second dimension can be preserved
If iB > 1 Then ReDim Preserve arrB(1 To iB - 1)
Range("C1").Resize(UBound(arrA), 1).value = Application.Transpose(arrA)
Range("D1").Resize(UBound(arrB), 1).value = Application.Transpose(arrB)
End Sub
And a version using a dictionary, processing as many as `Data x' slices exist:
Sub Split1DArrayDict()
Dim MainArray, n As Long, x As Long, arrIt, dict As Object
'for exemplification place the picture content in A:A column, then place it in a (2D) array:
MainArray = Application.Transpose(Range("A1:A18").value) 'obtaining a 1D array from the same range...
Set dict = CreateObject("Scripting.Dictionary")
For n = LBound(MainArray) To UBound(MainArray)
If MainArray(n) <> "" Then
If Split(MainArray(n), " ")(0) = "Data" Then
x = x + 1
dict.Add x, Array(MainArray(n))
arrIt = dict(x)
Else
ReDim Preserve arrIt(UBound(arrIt) + 1)
arrIt(UBound(arrIt)) = MainArray(n)
dict(x) = arrIt
End If
End If
Next n
For n = 0 To dict.count - 1
cells(1, 3 + n).Resize(UBound(dict.items()(n)) + 1, 1).value = Application.Transpose(dict.items()(n))
Next n
End Sub