VBA: new 1-D array from selected index on 2-D array

EuroSong

New Member
Joined
Sep 29, 2007
Messages
18
Hello all. I'm trying to find an easy way of converting a selected index within a 2-dimensional array into a 1-dimensional array. For example, if I have the following:

TwoDArr(1,1)="OneOne"
TwoDArr(1,2)="OneTwo"
TwoDArr(2,1)="TwoOne"
TwoDArr(2,2)="TwoTwo"

... I want to do something like this:
OneDArr=TwoDArr(2): with the result being OneDArr(1)="TwoOne" and OneDArr(2)="TwoTwo". See what I mean?

I have created a function to do it the long way round as follows:

Function TwoD_OneD(arr() As Variant, Index As Integer) As Variant
' arr is a 2D array. Index is the number of the first dimension. All the items in the second dimension will be taken into a new array
Dim TempArr()
Dim y As Integer, UB As Integer
UB = UBound(arr, 2)
ReDim TempArr(1 To UB)
For y = 1 To UB
If arr(Index, y) <> "" Then
TempArr(y) = arr(Index, y)
Else
' Reached the end of the actual data (although the array may be potentially larger)
ReDim Preserve TempArr(1 To y - 1)
Exit For ' Curtail the size of the array to only that which actually holds data.
End If
Next y
TwoD_OneD = TempArr
End Function

The above function is called as:
OneDArr=TwoD_OneD(TwoDArr, 2)

It works, but I am not satisfied with it. For a start, it's messy to have to redim a temporary array to the entire size of the input array's second dimension, when the selected index of the first dimension might not necessarily use all the elements of the second dimension. (I mean for example, arr(1,x) could go up to x=10; but arr(2,x) could go up to x=5. However because in the first series the second element goes up to 10, that must also be the size of the second element - even though items 6-10 are blank)

I found a page (How can I get one dimension from a bi-dimensional array in VB.Net? - Stack Overflow) which seemed to suggest that VBA could handle this natively, with a single line (OneDArr=TwoDArr(index)). However when I tried that, I got a compile error. Either Excel's flavour of VBA does not handle this sort of thing, or I'm doing it wrong.

Can anyone suggest a better way of doing this than the messy function I am using?
 
Since you appear to be working with jagged arrays, I suggest you use a 1D array of arrays instead of a 2D array in the first place.
 
Upvote 0

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Since you appear to be working with jagged arrays, I suggest you use a 1D array of arrays instead of a 2D array in the first place.
Hi Rory,
. Thanks for the input.
. I do not quite follow ( NEI ;) )
.. I guess you mean getting finally to this point?

Code:
Sub Rory1DArrayofArrays()Dim OneDTwoDArr(1 To 3) As Variant


OneDTwoDArr(1) = Array("OneOne", "Onetwo", "OneThree")
OneDTwoDArr(2) = Array("TwoOne", "Twotwo")
OneDTwoDArr(3) = Array("ThreeOne", "ThreeTwo", "ThreeThree")


End Sub

– From that point The OP has a simple method to get at his rows as per his request in Post #1 with something of the form ( as example for the second row )
OneDArr=OneDTwoDArr(2)
.
. However I do not see a simple way without looping in a complicated Function to create that 1D array of 2D arrays from his original 2 D Array.
.
. So I think he is back where he started? Or can You elaborate what You meant , bearing in mind the OP‘s original request? : - ( If understood the OP’s initial request his start point was getting rows in a simple way from an existing 2 Dimensional Array , ( with the added requirement to ignore blanks in the rows ) )
….
…. trying to find an easy way of converting a selected index within a 2-dimensional array into a 1-dimensional array. For example, if I have the following:

TwoDArr(1,1)="OneOne"
TwoDArr(1,2)="OneTwo"
TwoDArr(2,1)="TwoOne"
TwoDArr(2,2)="TwoTwo"

... I want to do something like this:
OneDArr=TwoDArr(2): with the result being OneDArr(1)="TwoOne" and OneDArr(2)="TwoTwo". See what I mean?........Can anyone suggest a better way of doing this than the messy function I am using?

Alan
 
Upvote 0
I meant he should skip creating a 2D array to start with, since it doesn't appear to be what he actually wants.
 
Upvote 0
Doc Alan - thank you so much for your input. However it appears as complicated (if not more so) than the way I'm already doing things anyway :)

Rory - I think you're onto something there! I did not realise it was possible to create a 1D "array of arrays". This is exactly why I came to this forum: new ideas that may previously have been thought as impossible. I will try it. Seems like what I need. Something like this:

Code:
Sub ArrayofArrays()
    Dim MasterArray() As Variant
    ReDim MasterArray(1 To 3)
    Dim x As Integer
    For x = 1 To 3
        MasterArray(x) = GrabValues(x)
    Next x
    ' And to test...
    MsgBox UBound(MasterArray(1))
    MsgBox UBound(MasterArray(2))
    MsgBox UBound(MasterArray(3))
End Sub

Function GrabValues(x As Integer) As Variant
    Select Case x
        Case 1
            GrabValues = Array("OneOne", "Onetwo", "OneThree")
        Case 2
            GrabValues = Array("TwoOne", "Twotwo")
        Case 3
            GrabValues = Array("ThreeOne", "ThreeTwo", "ThreeThree")
    End Select
End Function

Still interested in Rick's other methods though :)
 
Upvote 0
Hi EuroSong.
Doc Alan - thank you so much for your input. However it appears as complicated (if not more so) .......

. your welcome . The extra complication comes from the ability to select columns which I appreciate you do not need. But that helped me to get the other function, which as a “one liner” seemed similar to Rick’s

..................
......Rory - I think you're onto something there! I did not realise it was possible to create a 1D "array of arrays". This is exactly why I came to this forum: new ideas that may previously have been thought as impossible. I will try it......

. His idea made me think further as well.. Here, for example, what I was thinking if your start point was that you had a 2 Dimensional Array...

. ....This function would get your one dimensional Array of Arrays from your 2 dimensional Array ( Again ignore the additional Sub included for my later reference on how I got to the function ! )

Code:
[COLOR=blue]Function[/COLOR] OneDArrayofArrays(Arr [COLOR=blue]As[/COLOR] [COLOR=blue]Variant[/COLOR]) [COLOR=blue]As[/COLOR] [COLOR=blue]Variant[/COLOR]
[COLOR=blue]Dim[/COLOR] OneDTwoDArr() [COLOR=blue]As[/COLOR] Variant: [COLOR=blue]ReDim[/COLOR] OneDTwoDArr(1 [COLOR=blue]To[/COLOR] [COLOR=blue]UBound[/COLOR](Arr, 2))
[COLOR=blue]Dim[/COLOR] strtemp [COLOR=blue]As[/COLOR] [COLOR=blue]String[/COLOR]
[COLOR=blue]Dim[/COLOR] j [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], i [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR]
    [COLOR=blue]For[/COLOR] j = 1 [COLOR=blue]To[/COLOR] [COLOR=blue]UBound[/COLOR](Arr, 1)
        [COLOR=blue]For[/COLOR] i = 1 [COLOR=blue]To[/COLOR] [COLOR=blue]UBound[/COLOR](Arr, 2)
        [COLOR=blue]If[/COLOR] Arr(j, i) <> "" [COLOR=blue]Then[/COLOR] [COLOR=blue]Let[/COLOR] strtemp = strtemp & " " & Arr(j, i)
        [COLOR=blue]Next[/COLOR] i
    OneDTwoDArr(j) = Split(Trim(strtemp), " ")
    [COLOR=blue]Let[/COLOR] strtemp = ""
    [COLOR=blue]Next[/COLOR] j
OneDArrayofArrays = OneDTwoDArr()
[COLOR=blue]End[/COLOR] [COLOR=blue]Function[/COLOR]
[COLOR=lightgreen]'[/COLOR]
'
'
'
'
'
[COLOR=lightgreen]'[/COLOR]
'
 
 
[COLOR=blue]Sub[/COLOR] OneDArrayofArraysfromTwoDArray()
[COLOR=lightgreen]'[/COLOR]
[COLOR=blue]Dim[/COLOR] TwoDArr(1 [COLOR=blue]To[/COLOR] 3, 1 [COLOR=blue]To[/COLOR] 3) [COLOR=blue]As[/COLOR] [COLOR=blue]Variant[/COLOR]
TwoDArr(1, 1) = "OneOne"
TwoDArr(1, 2) = "OneTwo"
TwoDArr(1, 3) = "OneThree"
TwoDArr(2, 1) = "TwoOne"
TwoDArr(2, 2) = "TwoTwo"
TwoDArr(2, 3) = "" [COLOR=lightgreen]'Blank to be ignored[/COLOR]
TwoDArr(3, 1) = "ThreeOne"
TwoDArr(3, 2) = "ThreeTwo"
TwoDArr(3, 3) = "ThreeThree"
 
 
 
[COLOR=blue]Dim[/COLOR] OneDTwoDArr() [COLOR=blue]As[/COLOR] Variant: [COLOR=blue]ReDim[/COLOR] OneDTwoDArr(1 [COLOR=blue]To[/COLOR] [COLOR=blue]UBound[/COLOR](TwoDArr(), 2)) [COLOR=lightgreen]'Dimension OneDTwoDArr as 1 [COLOR=blue]Dim[/COLOR]ension Array of size equal to rows of 2DArray[/COLOR]
[COLOR=blue]Dim[/COLOR] strtemp [COLOR=blue]As[/COLOR] [COLOR=blue]String[/COLOR] [COLOR=lightgreen]'Temp String for Row contents[/COLOR]
Dim j [COLOR=blue]As[/COLOR] Long, i As Long
    [COLOR=blue]For[/COLOR] j = 1 [COLOR=blue]To[/COLOR] [COLOR=blue]UBound[/COLOR](TwoDArr(), 1) [COLOR=lightgreen]'For each (Row) 1 D Array element)[/COLOR]
        [COLOR=blue]For[/COLOR] i = 1 To [COLOR=blue]UBound[/COLOR](TwoDArr(), 2) [COLOR=lightgreen]'For each column in 2 dimensional Array[/COLOR]
        [COLOR=blue]If[/COLOR] TwoDArr(j, i) <> "" [COLOR=blue]Then[/COLOR] [COLOR=blue]Let[/COLOR] strtemp = strtemp & " " & TwoDArr(j, i) [COLOR=lightgreen]'Build string if not blank entry[/COLOR]
        [COLOR=blue]Next[/COLOR] i
    OneDTwoDArr(j) = Split(Trim(strtemp), " ") [COLOR=lightgreen]'Create 1 dimensional Array of Row elements in 2 dimensional Array and place in 1 Dimensional Array of Arrays[/COLOR]
    [COLOR=blue]Let[/COLOR] strtemp = "" [COLOR=lightgreen]'Set temp String to null for next (row) loop[/COLOR]
    [COLOR=blue]Next[/COLOR] j
 
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]
[COLOR=lightgreen]'[/COLOR]
'
.......




And subsequently you obtain ( for example your original second ) Row in subsequent code in this form:

Code:
[COLOR=blue]Sub[/COLOR] TestFunctionOneDArrayofArrays()
 
[COLOR=blue]Dim[/COLOR] TwoDArr(1 [COLOR=blue]To[/COLOR] 3, 1 To 3) [COLOR=blue]As[/COLOR] [COLOR=blue]Variant[/COLOR]
TwoDArr(1, 1) = "OneOne"
TwoDArr(1, 2) = "OneTwo"
TwoDArr(1, 3) = "OneThree"
TwoDArr(2, 1) = "TwoOne"
TwoDArr(2, 2) = "TwoTwo"
TwoDArr(2, 3) = "" [COLOR=lightgreen]'Blank to be ignored[/COLOR]
TwoDArr(3, 1) = "ThreeOne"
TwoDArr(3, 2) = "ThreeTwo"
TwoDArr(3, 3) = "ThreeThree"
 
[COLOR=blue]Dim[/COLOR] OneDTwoDArr() [COLOR=blue]As[/COLOR] [COLOR=blue]Variant[/COLOR]
[COLOR=blue]Let[/COLOR] OneDTwoDArr() = OneDArrayofArrays(TwoDArr)
 
[COLOR=blue]Dim[/COLOR] OneDArray [COLOR=blue]As[/COLOR] [COLOR=blue]Variant[/COLOR]
[COLOR=lightgreen]'Example for second Row[/COLOR]
[COLOR=blue]Let[/COLOR] OneDArray = OneDTwoDArr(2)
 
 
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]

...............................

......
Still interested in Rick's other methods though

. me too

Alan
 
Upvote 0
Still interested in Rick's other methods though :)
Okay, here you go. If your values are always numeric or they are always text without spaces, or a combination of those two (the key being no spaces in any cells), then you can use this function...

Code:
[SIZE=1]Function OneD(Arr As Variant, Index As Long) As Variant
  OneD = Split(RTrim(Join(Application.Index(Arr, Index, 0))))
End Function[/SIZE]

If, however, the cells could possibly contain spaces, then you would use this function instead...

Code:
[SIZE=1]Function OneD(Arr As Variant, Index As Long) As Variant
  OneD = Split(Replace(Replace(RTrim(Replace(Replace(Join(Application.Index(Arr, Index, _
         0), Chr(1)), " ", Chr(2)), Chr(1), " ")), " ", Chr(1)), Chr(2), " "), Chr(1))
End Function[/SIZE]
 
Last edited:
Upvote 0
Okay, here you go. .........

.. Great Rick.
. - How you keep a clear head constructing those multiple ( nested ) replace functions is amazing..
. I have worked through , opening up the Functions to understand them. They work great ( obviously ! ).
. Thanks again
Alan

P.s. In case it helps anyone looking in, here are my opened up versions of Rick’s Functions along with a Test code

Code:
[color=lightgreen]'[/color]
'
'http://www.mrexcel.com/forum/excel-questions/867942-visual-basic-applications-new-1-d-array-selected-index-2-d-array-2.html#post4213878
 
 
[color=blue]Function[/color] OneDNoSpace(Arr [color=blue]As[/color] [color=blue]Variant[/color], rwIndex [color=blue]As[/color] [color=blue]Long[/color]) [color=blue]As[/color] [color=blue]Variant[/color]
  [color=lightgreen]'OneDNoSpace = Split(RTrim(Join(Application.Index(Arr, rwIndex, 0))))[/color]
  OneDNoSpace = Application.Index(Arr, rwIndex, 0) [color=lightgreen]'Slice Row( Includs space )[/color]
  OneDNoSpace = Join(OneDNoSpace, " ") [color=lightgreen]'Make string from rowcontents with space between[/color]
  OneDNoSpace = Trim(OneDNoSpace) [color=lightgreen]'RTrim(OneDNoSpace)'trim off last space[/color]
  OneDNoSpace = Split(OneDNoSpace, " ") [color=lightgreen]'Make 1 dimensional array using split Function[/color]
[color=blue]End[/color] [color=blue]Function[/color]
[color=lightgreen]'[/color]
Function OneDSpace(Arr [color=blue]As[/color] [color=blue]Variant[/color], rwIndex [color=blue]As[/color] [color=blue]Long[/color]) [color=blue]As[/color] [color=blue]Variant[/color]
[color=lightgreen]'OneDSpace = Split(Replace(Replace(RTrim(Replace(Replace(Join(Application.Index(Arr, rwIndex, _
         0), Chr(1)), " ", Chr(2)), Chr(1), " ")), " ", Chr(1)), Chr(2), " "), Chr(1))[/color]
OneDSpace = Application.Index(Arr, rwIndex, 0) [color=lightgreen]'Make string from rowcontents with space between[/color]
OneDSpace = Join(OneDSpace, Chr(1)) [color=lightgreen]'Appears to join with two spaces ( Tab? )[/color]
OneDSpace = Replace(OneDSpace, " ", Chr(2)) [color=lightgreen]'replaces a space with something odd[/color]
OneDSpace = Replace(OneDSpace, Chr(1), " ") [color=lightgreen]'Replaces the ( Tab? ) with one space[/color]
OneDSpace = Trim(OneDSpace) [color=lightgreen]'RTrim(OneDSpace)'Take off last space[/color]
OneDSpace = Replace(OneDSpace, " ", Chr(1)) [color=lightgreen]'Replaces the space with a ( Tab? )[/color]
OneDSpace = Replace(OneDSpace, Chr(2), " ") [color=lightgreen]'Replaces the odd thing with a space[/color]
OneDSpace = Split(OneDSpace, Chr(1)) [color=lightgreen]'Make 1 dimensional array using split Function[/color]
[color=blue]End[/color] Function
[color=lightgreen]'[/color]
[color=blue]Sub[/color] TestRick2()
[color=blue]Dim[/color] TwoDArr(1 [color=blue]To[/color] 3, 1 To 3) [color=blue]As[/color] [color=blue]Variant[/color]
TwoDArr(1, 1) = "OneOne"
TwoDArr(1, 2) = "OneTwo"
TwoDArr(1, 3) = "OneThree"
TwoDArr(2, 1) = "TwoOne"
TwoDArr(2, 2) = "TwoTwo"
TwoDArr(2, 3) = "" [color=lightgreen]'Blank to be ignored[/color]
TwoDArr(3, 1) = "ThreeOne"
TwoDArr(3, 2) = "ThreeTwo"
TwoDArr(3, 3) = "ThreeThree"
[color=lightgreen]'Test OneDNoSpace[/color]
[color=blue]Dim[/color] OneDArr [color=blue]As[/color] [color=blue]Variant[/color]
[color=blue]Let[/color] OneDArr = OneDNoSpace(TwoDArr, 2)
 
[color=lightgreen]'Test OneDSpace[/color]
TwoDArr(2, 2) = "Two Two" [color=lightgreen]'Case wanted space[/color]
[color=blue]Dim[/color] OneDArr2 [color=blue]As[/color] [color=blue]Variant[/color]
[color=blue]Let[/color] OneDArr2 = OneDSpace(TwoDArr, 2)
[color=blue]End[/color] [color=blue]Sub[/color]
 
Upvote 0
.. Great Rick.
. - How you keep a clear head constructing those multiple ( nested ) replace functions is amazing..
It is actually not that hard... you do not write it from left-to-right, rather, you construct the code line from the inside out, each intermediate constructed result being the argument for the next function (which you place around it). It involves a lot of jumping from front to back as you place each new function around the intermediate one you just constructed, but it is much easier to keep the steps and syntax straight when you do it that way.


. I have worked through , opening up the Functions to understand them. They work great ( obviously ! ).

OneDSpace = Join(OneDSpace, Chr(1)) 'Appears to join with two spaces ( Tab? )
No, it is not a tab nor two spaces. Chr(1) is a single character whose ASCII code is 1 and, likewise, Chr(2) is a single character whose ASCII code is 2... I don't know what those characters are, but I do know that they will not appear in the text being processed, so I cannot inadvertently end up replacing part of the real text while I am manipulating the text at each step. If I knew for a fact that, say, and asterisk (*) and an at-sign (@) would never appear in the text, I could replace each Chr(1) with "*" and each Chr(2) with "@" and the code would work the same, but since I have no idea what characters could make up the text, I chose to use characters I am nearly 100% positive the person creating the text would not know how to include within that text. As for why Chr(1) appears as multiple characters... it is just the way VB interprets when it tries to print it.
 
Upvote 0
..you do not write it from left-to-right, rather, you construct code line from inside out, each intermediate constructed result being the argument for the next function (which you place around it). It involves a lot of jumping from front to back as you place each new function around the intermediate one you just constructed, but it is much easier to keep the steps and syntax straight when you do it that way....
..

.... Thanks, I have done a similar sort of thing sometimes for much simpler examples, such as in the extra codes I presented here in the code windows containing my Functions. And I sort of “open up” your Functions working in reverse to this method.. but I still lack the experience to come up with the complicated Replace(Replace(Replace things that I have noticed is one of your specialities. Thanks for the valuable insight into your way of thinking.


.....a tab nor two spaces. Chr(1) is a single character whose ASCII code is 1 and, likewise, Chr(2) is a single character whose ASCII code is 2... I don't know what those characters are, but I do know that they will not appear in the text being processed, .....since I have no idea what characters could make up the text, I chose to use characters I am nearly 100% positive the person creating the text would not know how to include within that text. As for why Chr(1) appears as multiple characters... it is just the way VB interprets when it tries to print it.

.... Thanks that clears that up nicely – by googling I saw they had no text value, so with your explanation it all makes sense now.

................
. Thanks for coming back to the Thread again and sharing that extra info.

Alan Elston
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,289
Members
452,631
Latest member
a_potato

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top