• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Handling Arrays [SOLVED]

A

al_noggin

New Member
Hello, I am trying to combine two ranges into one array to be used in functions that can only take a continuous array as an input. I am close to successfully creating the function to do that, but it looks like I am doing something wrong. The function works fine if the two ranges I am trying to combine have more than one value, but breaks down if one of the arrays has only one value, except if the one value is a number. For example if the two ranges comprise of dates and the second range only has one date, the function does not work. But if it is one number, then it works. Any help would be appreciated. Code posted below:

[pre]
Code: 
Function mergeArrays2(Array1, Array2)
Dim holdarr As Variant
Dim ub1 As Long, arr1 As Variant, arr2 As Variant
Dim ub2 As Long
Dim bi As Long
Dim i As Long
Dim newind As Integer

arr1 = Application.Index(Array1.Value, 0)
arr2 = Application.Index(Array2.Value, 0)
newind = 0

ub1 = UBound(arr1)
ub2 = UBound(arr2)

bi = ub1 + ub2

ReDim holdarr(ub1 + ub2 - 1)

For i = 1 To bi

If i <= ub1 Then
holdarr(newind) = arr1(i)
newind = newind + 1
End If

If i > ub1 And i <= bi Then
For j = 1 To ub2
holdarr(newind) = arr2(j)
newind = newind + 1
i = i + 1
Next j
End If

Next i

mergeArrays2 = holdarr
End Function
[/pre]
 
I'd suggest taking a look at Chip's page here, which has several wonderful functions for working with arrays.

http://www.cpearson.com/excel/vbaarrays.htm
 
Thanks for the link. I will take a look. But for my education, do you see what I am doing wrong with the Ubound function?
 
I think I see a possible error, but it depends on what
Code: 
Array1 and [code]Array2 really are. Assuming they are ranges, they will cause [code]arr1 to become a range type array. Now, the trick with those is that while a simple inspection makes it look like the values are stored with a single variable, ie arr(1), arr(2)
, etc., the values are actually stored using 2 variables, ie. arr(1,1), arr(1,2), arr(1,3)[/code] etc. This is easiest to see when you right click on the variable and add a watch, and then examine it after you've loaded the data.


That said, when you try and take the data and feed it into your holdarr[/code], which uses only single variable, you would get a problem.
 
If your ranges do not exceed 70,000 rows X 1 column limit then you may overcome the 'Base 1' barrier that Luke has pointed out.


You can do before passing it to your function:

Code: 
Array1 = Application.Transpose(MyRange.value)


If you are going to deal with ranges then you may also consider a method which can directly merge ranges [Union]

[pre]Public Sub MergeArray()
Dim r1 As Range, r2 As Range, r3 As Range, r As Range
Dim v As Variant
Dim i As Long

Set r1 = Range("A1:A2")
Set r2 = Range("B1:B2")
Set r3 = Union(r1, r2) 'Combine ranges

'Resize array
ReDim v(r3.Cells.Count - 1)
i = 0

'Add elements to the array
For Each r In r3
v(i) = r.Value
i = i + 1
Next r

'Print contents of array to immediate window
For i = LBound(v) To UBound(v)
Debug.Print v(i)
Next i

End Sub
[/pre]
 
Hi ,


This seems to work as well :

[pre]
Code: 
Function mergeArrays2(Array1 As Range, Array2 As Range)
Dim holdarr As Variant
Dim ub1 As Long
Dim ub2 As Long
Dim bi As Long
Dim i As Long
Dim newind As Integer

newind = 0

ub1 = Array1.Rows.Count
ub2 = Array2.Rows.Count

bi = ub1 + ub2

ReDim holdarr(ub1 + ub2 - 1)

For i = 1 To bi

If i <= ub1 Then
holdarr(newind) = Array1(i)
newind = newind + 1
End If

If i > ub1 And i <= bi Then
For j = 1 To ub2
holdarr(newind) = Array2(j)
newind = newind + 1
i = i + 1
Next j
End If

Next i

mergeArrays2 = holdarr
End Function
[/pre]
Narayan
 
Guys, this is great! Thanks so much for all your help. I am definitely getting a better understanding of arrays now.
 
If we're dealing with ranges, then instead of iterating through the arrays, and creating a new one out of both of the old ones, it will be more efficient to keep the larger range and simply add the elements of the smaller one to it.


Especially if the large range is huge.

Here's my suggested approach, that handles both 1d and 2d ranges:

[pre]
Code: 
Function MergeRanges(rng1 As Range, rng2 As Range)

Dim lngColumns As Long
Dim lngLarge As Long
Dim lngSmall As Long
Dim varLarge() As Variant
Dim varSmall() As Variant
Dim lngNew As Long
Dim i As Long
Dim j As Long

lngColumns = rng1.Columns.Count
If lngColumns <> rng2.Columns.Count Then
MergeRanges = CVErr(xlErrValue)    'Ranges have different numbers of columns.
Else

' Work out which range is largest. We'll suck that into varLarge and then simply
' add the values from the smaller range to it.
lngLarge = rng1.Rows.Count
lngSmall = rng2.Rows.Count
If lngLarge >= lngSmall Then
'We've got to use Application.Transpose because we need rows to be the last dimension so that we can resize it.
varLarge = Application.Transpose(rng1)
varSmall = Application.Transpose(rng2)
Else:
varLarge = Application.Transpose(rng2)
varSmall = Application.Transpose(rng1)
lngSmall = lngLarge
lngLarge = UBound(varLarge)
End If

lngNew = lngLarge + lngSmall
' We have to do thing differently depending on whether ranges are 1d or 2d
If lngColumns > 1 Then
ReDim Preserve varLarge(lngColumns, lngNew)
For i = 1 To lngSmall
For j = 1 To lngColumns
varLarge(j, lngLarge + i) = varSmall(j, i)
Next j
Next i
Else
ReDim Preserve varLarge(lngNew)
For i = 1 To lngSmall
varLarge(lngLarge + i) = varSmall(i)
Next i
End If

MergeRanges = Application.Transpose(varLarge)
End If
End Function
[/pre]
 
Hi Jeff ,


When I tried out your code , I had to make one or two changes ; can you confirm ?

[pre]
Code: 
Option Base 1

Function MergeRanges(rng1 As Range, rng2 As Range)

Dim lngColumns As Long
Dim lngLarge As Long
Dim lngSmall As Long
Dim varLarge As Variant
Dim varSmall As Variant
Dim lngNew As Long
Dim i As Long
Dim j As Long

lngColumns = rng1.Columns.Count

If lngColumns <> rng2.Columns.Count Then
MergeRanges = CVErr(xlErrValue)    'Ranges have different numbers of columns.
Else

' Work out which range is largest. We'll suck that into varLarge and then simply
' add the values from the smaller range to it.
lngLarge = rng1.Rows.Count
lngSmall = rng2.Rows.Count
If lngLarge >= lngSmall Then
'We've got to use Application.Transpose because we need rows to be the last dimension so that we can resize it.
varLarge = Application.Transpose(rng1)
varSmall = Application.Transpose(rng2)
Else:
varLarge = Application.Transpose(rng2)
varSmall = Application.Transpose(rng1)
lngSmall = lngLarge
lngLarge = UBound(varLarge)
End If

lngNew = lngLarge + lngSmall
' We have to do thing differently depending on whether ranges are 1d or 2d
If lngColumns > 1 Then
ReDim Preserve varLarge(lngColumns, lngNew)
For i = 1 To lngSmall
For j = 1 To lngColumns
varLarge(j, lngLarge + i) = varSmall(j, i)
Next j
Next i
Else
ReDim Preserve varLarge(lngNew)
For i = 1 To lngSmall
varLarge(lngLarge + i) = varSmall(i)
Next i
End If

MergeRanges = Application.Transpose(varLarge)
End If
End Function
[/pre]
Narayan
 
Note that this will only handle arrays up to 65536 rows in length even if using Excel 2007 or greater, due to an inbuilt limit in how much data you can return from VBA to Excel via a UDF.

I also found a small bug in the above code. Here is the amended code:

[pre]
Code: 
Function MergeRanges(rng1 As Range, rng2 As Range)

Dim lngColumns As Long
Dim lngLarge As Long
Dim lngSmall As Long
Dim varLarge() As Variant
Dim varSmall() As Variant
Dim lngNew As Long
Dim i As Long
Dim j As Long

lngColumns = rng1.Columns.Count
If lngColumns <> rng2.Columns.Count Then
MergeRanges = CVErr(xlErrValue)    'Ranges have different columns.
Else

' Work out which range is largest. We'll suck that into varLarge and then simply
' add the values from the smaller range to it.
lngLarge = rng1.Rows.Count
lngSmall = rng2.Rows.Count
If lngLarge >= lngSmall Then
'We've got to use Application.Transpose because we need rows to be the last dimension so that we can resize it.
varLarge = Application.Transpose(rng1)
varSmall = Application.Transpose(rng2)
Else:
varLarge = Application.Transpose(rng2)
varSmall = Application.Transpose(rng1)
lngSmall = lngLarge
lngLarge = rng2.Rows.Count
End If

lngNew = lngLarge + lngSmall
' We have to do thing differently depending on whether ranges are 1d or 2d
If lngColumns > 1 Then
ReDim Preserve varLarge(lngColumns, lngNew)
For i = 1 To lngSmall
For j = 1 To lngColumns
varLarge(j, lngLarge + i) = varSmall(j, i)
Next j
Next i
Else
ReDim Preserve varLarge(lngNew)
For i = 1 To lngSmall
varLarge(lngLarge + i) = varSmall(i)
Next i
End If

MergeRanges = Application.Transpose(varLarge)
End If
End Function
[/pre]
 
Hi Narayan. Sorry, didn't see your post till I posted the above. Yep, there was a small bug. For my existing code, the trick was to change this line:

lngLarge = UBound(varLarge)

...to this:

lngLarge = rng2.Rows.Count


Yours still won't work in the case that rng2 is larger than rng2, without changing the same line.
 
Hi Jeff ,


I had tried out your code only for two cases viz. 1d ranges of same length , and 2d ranges of same dimensions.


Narayan
 
You must log in or register to reply here.
Back
Top