Get output arrays from each column in range

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Get output arrays from each column in range

Post by YasserKhalil »

Hello everyone
I have the following UDF that enables me to get four 1d arrays from each column in a range

Code: Select all

Sub Test()
    Dim v
    v = GetArrays(Range("C6:F11"))(3)
End Sub

Function GetArrays(rng As Range) As Variant
    Dim arrValues() As Variant
    Dim arrC() As Variant, arrD() As Variant, arrE() As Variant, arrF() As Variant
    Dim i As Integer, j As Integer
    Dim countC As Integer, countD As Integer, countE As Integer, countF As Integer
    arrValues = rng.Value
    ReDim arrC(1 To rng.Rows.Count)
    ReDim arrD(1 To rng.Rows.Count)
    ReDim arrE(1 To rng.Rows.Count)
    ReDim arrF(1 To rng.Rows.Count)
    For i = 1 To UBound(arrValues)
        If Not IsEmpty(arrValues(i, 1)) Then
            countC = countC + 1
            arrC(countC) = arrValues(i, 1)
        End If
        If Not IsEmpty(arrValues(i, 2)) Then
            countD = countD + 1
            arrD(countD) = arrValues(i, 2)
        End If
        If Not IsEmpty(arrValues(i, 3)) Then
            countE = countE + 1
            arrE(countE) = arrValues(i, 3)
        End If
        If Not IsEmpty(arrValues(i, 4)) Then
            countF = countF + 1
            arrF(countF) = arrValues(i, 4)
        End If
    Next i
    ReDim Preserve arrC(1 To countC)
    ReDim Preserve arrD(1 To countD)
    ReDim Preserve arrE(1 To countE)
    ReDim Preserve arrF(1 To countF)
    GetArrays = Array(arrC, arrD, arrE, arrF)
End Function

How to make it more flexible so as to make the UDF recognize the number of columns and I can get unlimited 1d array for each column in the array?

User avatar
HansV
Administrator
Posts: 78229
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Get output arrays from each column in range

Post by HansV »

Code: Select all

Function GetArrays(rng As Range) As Variant
    Dim arrValues() As Variant, arrColumn() As Variant
    Dim r As Long, c As Long, m As Long, n As Long, s As Long
    arrValues = rng.Value
    m = UBound(arrValues, 1)
    n = UBound(arrValues, 2)
    ReDim arrReturn(1 To n) as variant
    For c = 1 To n
        s = 0
        ReDim arrColumn(1 To m)
        For r = 1 To m
            If Not IsEmpty(arrValues(r, c)) Then
                s = s + 1
                arrColumn(s) = arrValues(r, c)
            End If
        Next r
        ReDim Preserve arrColumn(1 To s)
        arrReturn(c) = arrColumn
    Next c
    GetArrays = arrReturn
End Function
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Get output arrays from each column in range

Post by YasserKhalil »

Amazing. Thank you very much for great help.

User avatar
DocAElstein
4StarLounger
Posts: 542
Joined: 18 Jan 2022, 15:59
Location: Re-routing rivers, in Hof, Beautiful Bavaria

Re: Get output arrays from each column in range

Post by DocAElstein »

Hello,
If you specifically want your function to return you an array of arrays, as the last two macros given are doing, then these alternatives will not directly help you, ( - you could modify them to give you that )
If you just want a UDF that enables you to get 1d arrays from each column in a range, then here is a couple of non looping alternatives

This first one will give you a 1D array which always has as many elements as there are rows in your range. Empty cells will be represented by elements of value Empty

Code: Select all

 Sub TestVee() '  http://www.eileenslounge.com/viewtopic.php?p=305791#p305791
Dim Vee() as Variant
 Let Vee() = GetArraysIndxEP(Range("C6:F11"), 3)
 Let Vee() = GetArraysIndx(Range("C6:F11"), 3)
End Sub
Public Function GetArraysIndx(ByVal Rng As Range, ByVal Clm As Long) As Variant
 Let GetArraysIndx = Application.Index(Rng, Evaluate("=Column(A:" & Split(Cells(1, Rng.Rows.Count).Address, "$")(1) & ")"), 3)
End Function













Public Function GetArraysIndxEP(ByVal Rng As Range, ByVal Clm As Long) As Variant
Dim arrValues() As Variant
 Let arrValues() = Application.Index(Rng, Array(1, 2, 3, 4, 5, 6), Array(3, 3, 3, 3, 3, 3))
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:F)"), Array(3, 3, 3, 3, 3, 3))
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:F)"), 3)                      '   Excel VBA Interception and Implicit Intersection Theory tells us that the extended range help matrix will be full with  3    https://excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp
Dim CL As String: Let CL = Split(Cells(1, 6).Address, "$", -1, vbBinaryCompare)(1)         '  Split on example  $E$1  will give like   ""     "E"    "1"     I want the second one which is the  index of  1   because split in default settings  is in base 0     so like in this 3 element example is like      0  1  2
 Let CL = Split(Cells(1, Rng.Rows.Count).Address, "$", -1, vbBinaryCompare)(1)
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:" & CL & ")"), 3)
' or
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:" & Split(Cells(1, Rng.Rows.Count).Address, "$")(1) & ")"), 3)
 Let GetArraysIndxEP = arrValues()
End Function 

_.___________________________________________-

This next one is a bit more beautiful and will do similar to Yassers and Hans macro, returning in the 1D array only as many elements as there are non empty cells in the column. (Note this last function will not work if you have values in the cells with spaces in them)

Code: Select all

 Sub TestVee() '  http://www.eileenslounge.com/viewtopic.php?p=305791#p305791
Dim Vee() As String
                                                                                                                ' Let Vee() = GetArraysIndxEP(Range("C6:F11"), 3)
                                                                                                                ' Let Vee() = GetArraysIndx(Range("C6:F11"), 3)
 Let Vee() = GetArraysIndxEP2(Range("C6:F11"), 3)                                                                                           ' Let Vee() = GetArraysClipboardEP(Range("C6:F11"), 3)
 Let Vee() = GetArraysIndx2(Range("C6:F11"), 3)
End Sub
Public Function GetArraysIndx2(ByVal Rng As Range, ByVal Clm As Long) As Variant
 Let GetArraysIndx2 = Split(Application.Trim(Join(Application.Index(Rng, Evaluate("=Column(A:" & Split(Cells(1, Rng.Rows.Count).Address, "$")(1) & ")"), 3), " ")), " ")
End Function
























Public Function GetArraysIndxEP2(ByVal Rng As Range, ByVal Clm As Long) As Variant
Dim arrValues() As Variant
 Let arrValues() = Application.Index(Rng, Array(1, 2, 3, 4, 5, 6), Array(3, 3, 3, 3, 3, 3))
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:F)"), Array(3, 3, 3, 3, 3, 3))
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:F)"), 3)                      '   Excel VBA Interception and Implicit Intersection Theory tells us that the extended range help matrix will be full with  3    https://excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp
Dim CL As String: Let CL = Split(Cells(1, 6).Address, "$", -1, vbBinaryCompare)(1)         '  Split on example  $E$1  will give like   ""     "E"    "1"     I want the second one which is the  index of  1   because split in default setings  is in base 0     so like in this 3 element example is like      0  1  2
 Let CL = Split(Cells(1, Rng.Rows.Count).Address, "$", -1, vbBinaryCompare)(1)
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:" & CL & ")"), 3)
' or
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:" & Split(Cells(1, Rng.Rows.Count).Address, "$")(1) & ")"), 3)
Dim strClm As String
 Let strClm = Join(arrValues(), " ")
 Let strClm = Application.Trim(strClm)                                     ' http://www.eileenslounge.com/viewtopic.php?p=301761#p301761
Dim strarrValues() As String
 Let strarrValues() = Split(strClm, " ", -1, vbBinaryCompare)
' or
 Let strarrValues() = Split(Application.Trim(Join(Application.Index(Rng, Evaluate("=Column(A:" & Split(Cells(1, Rng.Rows.Count).Address, "$")(1) & ")"), 3), " ")), " ")
 
 Let GetArraysIndxEP2 = strarrValues()
End Function



Alan
I seriously don’t ever try to annoy. Maybe I am just the kid that missed being told about the King’s new magic suit, :(

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Get output arrays from each column in range

Post by YasserKhalil »

I tested the second udf but I didn't get the arrays as expected. I changed the second parameter in this line `GetArraysIndxEP2(Range("C6:F11"), 2)` but I got the same result as in 3 or 1 or 4

User avatar
DocAElstein
4StarLounger
Posts: 542
Joined: 18 Jan 2022, 15:59
Location: Re-routing rivers, in Hof, Beautiful Bavaria

Re: Get output arrays from each column in range

Post by DocAElstein »

HI Yasser,
_... ah yes – a silly mistake on my behalf.. if you take a look at all the Index bits, you can see that I forgot to change the hard coded column index from 3 to the variable for the column number Clm

So everywhere, something like this:
Index(Rng, ______________, 3 )
, should be
Index(Rng, ______________, Clm )

Here you go:

Code: Select all

Sub TestVeeV() '  http://www.eileenslounge.com/viewtopic.php?p=305791#p305791
Dim VeeV() As Variant
 Let VeeV() = GetArraysIndxEP(Range("C6:F11"), 3)
 Let VeeV() = GetArraysIndx(Range("C6:F11"), 4)
End Sub

Public Function GetArraysIndx(ByVal Rng As Range, ByVal Clm As Long) As Variant
 Let GetArraysIndx = Application.Index(Rng, Evaluate("=Column(A:" & Split(Cells(1, Rng.Rows.Count).Address, "$")(1) & ")"), Clm)
End Function













Public Function GetArraysIndxEP(ByVal Rng As Range, ByVal Clm As Long) As Variant
Dim arrValues() As Variant
 Let arrValues() = Application.Index(Rng, Array(1, 2, 3, 4, 5, 6), Array(3, 3, 3, 3, 3, 3))
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:F)"), Array(3, 3, 3, 3, 3, 3))
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:F)"), 3)                      '   Excel VBA Interception and Implicit Intersection Theory tells us that the extended range help matrix will be full with  3    https://excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp
Dim CL As String: Let CL = Split(Cells(1, 6).Address, "$", -1, vbBinaryCompare)(1)        '  Split on example  $E$1  will give like   ""     "E"    "1"     I want the second one which is the  index of  1   because split in default setings  is in base 0     so like in this 3 element example is like      0  1  2
 Let CL = Split(Cells(1, Rng.Rows.Count).Address, "$", -1, vbBinaryCompare)(1)
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:" & CL & ")"), 3)
' or
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:" & Split(Cells(1, Rng.Rows.Count).Address, "$")(1) & ")"), 3)
' remember finally to change the hard coded column index
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:" & Split(Cells(1, Rng.Rows.Count).Address, "$")(1) & ")"), Clm)
 
 Let GetArraysIndxEP = arrValues()
End Function

Code: Select all

Sub TestVee() '  http://www.eileenslounge.com/viewtopic.php?p=305791#p305791
Dim Vee() As String
 Let Vee() = GetArraysIndxEP2(Range("C6:F11"), 4)                                                                                       
 Let Vee() = GetArraysIndx2(Range("C6:F11"), 3)
End Sub
Public Function GetArraysIndx2(ByVal Rng As Range, ByVal Clm As Long) As Variant
 Let GetArraysIndx2 = Split(Application.Trim(Join(Application.Index(Rng, Evaluate("=Column(A:" & Split(Cells(1, Rng.Rows.Count).Address, "$")(1) & ")"), Clm), " ")), " ")
End Function
























Public Function GetArraysIndxEP2(ByVal Rng As Range, ByVal Clm As Long) As Variant
Dim arrValues() As Variant
 Let arrValues() = Application.Index(Rng, Array(1, 2, 3, 4, 5, 6), Array(3, 3, 3, 3, 3, 3))
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:F)"), Array(3, 3, 3, 3, 3, 3))
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:F)"), 3)                      '   Excel VBA Interception and Implicit Intersection Theory tells us that the extended range help matrix will be full with  3    https://excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp
Dim CL As String: Let CL = Split(Cells(1, 6).Address, "$", -1, vbBinaryCompare)(1)         '  Split on example  $E$1  will give like   ""     "E"    "1"     I want the second one which is the  index of  1   because split in default setings  is in base 0     so like in this 3 element example is like      0  1  2
 Let CL = Split(Cells(1, Rng.Rows.Count).Address, "$", -1, vbBinaryCompare)(1)
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:" & CL & ")"), 3)
' or
 Let arrValues() = Application.Index(Rng, Evaluate("=Column(A:" & Split(Cells(1, Rng.Rows.Count).Address, "$")(1) & ")"), 3)
Dim strClm As String
 Let strClm = Join(arrValues(), " ")
 Let strClm = Application.Trim(strClm)                                     ' http://www.eileenslounge.com/viewtopic.php?p=301761#p301761
Dim strarrValues() As String
 Let strarrValues() = Split(strClm, " ", -1, vbBinaryCompare)
' or
 Let strarrValues() = Split(Application.Trim(Join(Application.Index(Rng, Evaluate("=Column(A:" & Split(Cells(1, Rng.Rows.Count).Address, "$")(1) & ")"), 3), " ")), " ")
' finally remember to change the hard coded colum to the column variable
 Let strarrValues() = Split(Application.Trim(Join(Application.Index(Rng, Evaluate("=Column(A:" & Split(Cells(1, Rng.Rows.Count).Address, "$")(1) & ")"), Clm), " ")), " ")
 Let GetArraysIndxEP2 = strarrValues()
End Function







_.______________________________________________________________________________________________________________________________

One other thing. If you prefer the second macros to return Variant type elements instead of String type elements , then you can play around with like, pseudo coding
VariantElementTypeArray = Index(StringElementTypeArray , 1, 0 )


So like this:

Code: Select all

 Sub TestVeeVV() '  http://www.eileenslounge.com/viewtopic.php?p=305791#p305791
Dim Vee() As String
 Let Vee() = GetArraysIndx22(Range("C6:F11"), 4)
 
Dim VeeV() As Variant
 Let VeeV() = Application.Index(Vee(), 1, 0)
End Sub
Public Function GetArraysIndx22(ByVal Rng As Range, ByVal Clm As Long) As Variant
 Let GetArraysIndx22 = Split(Application.Trim(Join(Application.Index(Rng, Evaluate("=Column(A:" & Split(Cells(1, Rng.Rows.Count).Address, "$")(1) & ")"), Clm), " ")), " ")
End Function





Or this to make it very beautiful

Code: Select all

 Sub TestVee22V()    '   https://www.eileenslounge.com/viewtopic.php?p=305940#p305940
Dim VeeV() As Variant
 Let VeeV() = GetArraysIndx22V(Range("C6:F11"), 4)
End Sub
Public Function GetArraysIndx22V(ByVal Rng As Range, ByVal Clm As Long) As Variant
 Let GetArraysIndx22V = Application.Index(Split(Application.Trim(Join(Application.Index(Rng, Evaluate("=Column(A:" & Split(Cells(1, Rng.Rows.Count).Address, "$")(1) & ")"), Clm), " ")), " "), 1, 0)
End Function
I seriously don’t ever try to annoy. Maybe I am just the kid that missed being told about the King’s new magic suit, :(

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Get output arrays from each column in range

Post by YasserKhalil »

Amazing. Thank you very much, Mr. Alan