Split VBA array according to specific values

[YasserKhalil]

Hello everyone
I have a range which is stored in a variable (arr) then it is stored in an array .. Range A2:Dx
In the third column of this array there are multiple values ..
I need to split the variable arr according to specific values .. The values are "A" & "B" & "D" & "Other"

So as for "A" (the output new created array) >> will hold the values of "A" in column C
As for "B" (the output new created array) >> will hold the values of "B" in column C
As for "D" (the output new created array) >> will hold the values of "D" in column C
As for any other entires, the output new created array will be "Other"

I imagine to put these values as needed in an array

x=Array("A","B","D","Other")

Finally I need as in the example four arrays for each value

Hope it is clear
Thanks advanced for help

[CK76]

So what exactly are you trying to do and what should the end result look like? Can you manually create expected output?

[YasserKhalil]

The output will be arrays .. I mean sub-arrays from this main array (the same idea as filter) in ranges .. but with arrays in that case
I imagine to get for example : arr_A and this will be an array that holds the values of the rows that has the value "A" in column C ...

I mean to produce arrays through the code itself ... Is it possible ?

[CK76]

Yes. Something like below. Though I'd probably use some other method, if I had to do something like this.

Sub Demo()
Dim tempArr, arr_A, arr_B, arr_D, arr_Oth
Dim a As Long, b As Long, d As Long, o As Long: a = 1: b = 1: d = 1: o = 1

tempArr = Cells(1).CurrentRegion

With Application
    ReDim arr_A(1 To .CountIf(Sheet1.Cells(1).CurrentRegion.Columns(3), "A"), 1 To 4)
    ReDim arr_B(1 To .CountIf(Sheet1.Cells(1).CurrentRegion.Columns(3), "B"), 1 To 4)
    ReDim arr_D(1 To .CountIf(Sheet1.Cells(1).CurrentRegion.Columns(3), "D"), 1 To 4)
    ReDim arr_Oth(1 To UBound(tempArr) - UBound(arr_A) - UBound(arr_B) - UBound(arr_D), 1 To 4)
End With

For i = 2 To UBound(tempArr)
    Select Case tempArr(i, 3)
    Case "A"
        arr_A(a, 1) = tempArr(i, 1)
        arr_A(a, 2) = tempArr(i, 2)
        arr_A(a, 3) = "A"
        arr_A(a, 4) = tempArr(i, 4)
        a = a + 1
    Case "B"
        arr_B(b, 1) = tempArr(i, 1)
        arr_B(b, 2) = tempArr(i, 2)
        arr_B(b, 3) = "B"
        arr_B(b, 4) = tempArr(i, 4)
        b = b + 1
    Case "D"
        arr_D(d, 1) = tempArr(i, 1)
        arr_D(d, 2) = tempArr(i, 2)
        arr_D(d, 3) = "D"
        arr_D(d, 4) = tempArr(i, 4)
        d = d + 1
    Case Else
        arr_Oth(d, 1) = tempArr(i, 1)
        arr_Oth(d, 2) = tempArr(i, 2)
        arr_Oth(d, 3) = "Other"
        arr_Oth(d, 4) = tempArr(i, 4)
        o = o + 1
    End Select
Next

Range("K1").Resize(UBound(arr_A), 4) = arr_A


End Sub

[YasserKhalil]

Thanks a lot Mr. Chihro for this great code
I think this part

    Case Else
        arr_Oth(d, 1) = tempArr(i, 1)
        arr_Oth(d, 2) = tempArr(i, 2)
        arr_Oth(d, 3) = "Other"
        arr_Oth(d, 4) = tempArr(i, 4)
        o = o + 1

d would be replaced with o

Generally this is fine and I can simulate that but I seek for generic approach to create the sub-arrays automatically .. through looping the elements of the array ("A","B","D","Other") without declaring variables .. I need the code itself to create these variables for me
I know it may be weird but I hope to find a way

[CK76]

For that you'd need to use dictionary or some other collection to hold individual arrays.

[YasserKhalil]

For that you'd need to use dictionary or some other collection to hold individual arrays.

So it is possible to do that by using collections.. That's great
But I have a little experience in using collections and I can't imagine the process well. Can you help me in that please?

[CK76]

Can you clarify few things before I think on logic for sample code?

"A", "B", "D", "Other", these category are constant or declared at start correct?

Also, you don't want multi-level dictionary/collection objects, but array as end result?

FYI - In my opinion, much easier to just build multi-level dictionary as it gives more control and far more flexible than array if you want to retrieve info.

[YasserKhalil]

Thanks a lot Mr. Chihiro
As for the values "A","B",etc .. I prefer to put them in one array
x=Array("A","B","D","other")
then to deal with those values either using arrays or collections (no matter) and finally got sub arrays for each item in x array ...
Best Regards

[CK76]

Here's one way to do it. There are many other ways to do this.

Sub Demo()
Dim tempArr, x
Dim condArr: condArr = Array("A", "B", "D", "Other")
Dim dic As Object

tempArr = Cells(1).CurrentRegion
Set dic = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tempArr)
    x = Application.Match(tempArr(i, 3), condArr, 0)
    If IsNumeric(x) Then
        dic(tempArr(i, 3)) = dic(tempArr(i, 3)) + 1
    Else
        tempArr(i, 3) = "Other"
        dic("Other") = dic("Other") + 1
    End If
Next

For Each Key In dic.Keys
    ReDim x(1 To dic(Key), 1 To 4)
    j = 1
    For i = 2 To UBound(tempArr)
        If tempArr(i, 3) = Key Then
            For k = LBound(tempArr, 2) To UBound(tempArr, 2)
                x(j, k) = tempArr(i, k)
            Next
            j = j + 1
        End If
    Next
    dic.Remove Key
    dic.Add Key, x
Next

'Here you can loop through Key or access data some other way
'Ex: Range("K1").Resize(UBound(dic("Other")), 4) = dic("Other")
For Each Key In dic.Keys
    For i = LBound(dic(Key)) To UBound(dic(Key))
        For j = LBound(dic(Key), 2) To UBound(dic(Key), 2)
            Debug.Print dic(Key)(i, j)
        Next
    Next
Next

End Sub

[YasserKhalil]

That's really awesome and wonderful
Thank you very very much Mr. Chihiro
God bless you .. Have a nice time