VBA function to consolidate arrays

[rharn]

I am trying to create a VBA function to consolidate two arrays that is generated from a sub. The objective is to compare to values contained in each array and to put any duplicated values into a new array and to finally pass the array back into the sub. There has been several variations of this function and I have attempted to create a function based off of these functions but my function currently enouncters a 'invalid or unqualified reference' when I try to use the built in .Match function. I would greatly appreciate it if anyone can take a quick look at my code below and let me know what's wrong!

Function lnArray(X As Variant, Y As Variant) As Variant
    Dim counter1 As Long
    Dim xcount As Long
    Dim t As Long
    Dim FinalResults() As Variant
 
        For xcount = LBound(X) To UBound(X)
            t = .Match(X(xcount), Y, 0)
                If (t > 0) Then
                    counter1 = counter1 + 1
                    ReDim Preserve FinalResults(counter1)
                    FinalResults(counter1) = X(xcount)
                End If
        Next xcount
 
    lnArray = FinalResults
End Function

 

[balajayan]

Can you please explain more of your requirement.

After checking the contents of X() in Y(), do you want to report the list which matched or what information do you expect from the function as an output?

 

[rharn]

balajayan, after I checke the contents of arrays X() and Y() I want all duplicate values to be recorded into a new array (FinalResults()). After the finalarray() is generated I want to pass this new array back into my sub routine so I can display the search results based off of the final array. I have already created the code to generate X() and Y() as well as to display the FinalResults(). It is the step inbetween, consolidating X() and Y() that I am having problems with

Please let me know if this answers your question, I can explain in more detail if necessary.

 

[MickG]

If you would like too try both these code based on a "One dim array" and a "Two dim array" you should be then able to use the code that returns you Sub Arrays.
Both these code are based on Numbers 1 to 10 in "A1:A10" and numbers 4 to 13 in "B1 to B10". Both Code return numbers 4 to 10.
One Dim Array

[COLOR="Navy"]Sub[/COLOR] MG27Jun19
[COLOR="Navy"]Dim[/COLOR] ray
[COLOR="Navy"]Dim[/COLOR] A
[COLOR="Navy"]Dim[/COLOR] B
A = Application.Transpose(Range("A1:A10").value)
B = Application.Transpose(Range("B1:B10").value)
   ray = lnArray(A, B)
Range("C1").Resize(UBound(ray) + 1) = Application.Transpose(ray)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Function lnArray(X [COLOR="Navy"]As[/COLOR] Variant, Y [COLOR="Navy"]As[/COLOR] Variant) [COLOR="Navy"]As[/COLOR] Variant
    [COLOR="Navy"]Dim[/COLOR] counter1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    [COLOR="Navy"]Dim[/COLOR] xcount [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    [COLOR="Navy"]Dim[/COLOR] t [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    [COLOR="Navy"]Dim[/COLOR] FinalResults() [COLOR="Navy"]As[/COLOR] Variant
    counter1 = 0
        [COLOR="Navy"]For[/COLOR] xcount = LBound(X) To UBound(X)
            [COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
            t = Application.match(X(xcount), Y, 0)
           [COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] GoTo 0
                [COLOR="Navy"]If[/COLOR] (t > 0) [COLOR="Navy"]Then[/COLOR]
                    ReDim Preserve FinalResults(counter1)
                    FinalResults(counter1) = X(xcount)
                    counter1 = counter1 + 1
                [COLOR="Navy"]End[/COLOR] If
           [COLOR="Navy"]Next[/COLOR] xcount
 
    lnArray = FinalResults
[COLOR="Navy"]End[/COLOR] Function

Two Dim Array

[COLOR="Navy"]Sub[/COLOR] MG27Jun56
[COLOR="Navy"]Dim[/COLOR] ray
[COLOR="Navy"]Dim[/COLOR] A
[COLOR="Navy"]Dim[/COLOR] B
A = Range("A1:A10").value
B = Range("B1:B10").value
   ray = knArray(A, B)
Range("C1").Resize(UBound(ray) + 1) = Application.Transpose(ray)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Function knArray(X [COLOR="Navy"]As[/COLOR] Variant, Y [COLOR="Navy"]As[/COLOR] Variant) [COLOR="Navy"]As[/COLOR] Variant
    [COLOR="Navy"]Dim[/COLOR] counter1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    [COLOR="Navy"]Dim[/COLOR] xcount [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    [COLOR="Navy"]Dim[/COLOR] t [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    [COLOR="Navy"]Dim[/COLOR] FinalResults() [COLOR="Navy"]As[/COLOR] Variant
    counter1 = 0
        [COLOR="Navy"]For[/COLOR] xcount = LBound(X) To UBound(X)
            [COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
            t = Application.match(X(xcount, 1), Y, 0)
           [COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] GoTo 0
                [COLOR="Navy"]If[/COLOR] (t > 0) [COLOR="Navy"]Then[/COLOR]
                    ReDim Preserve FinalResults(counter1)
                    FinalResults(counter1) = X(xcount, 1)
                    counter1 = counter1 + 1
                [COLOR="Navy"]End[/COLOR] If
           [COLOR="Navy"]Next[/COLOR] xcount
 
    knArray = FinalResults
[COLOR="Navy"]End[/COLOR] Function

Regards Mick

 

[rharn]

Hey Mick, Thanks for providing the details of your solution, I am currently looking at the 2nd one and it looks more attractive to me. Just a quick question however, I dont quite understand why you transpose the ray() at the end when you are displaying your results. Any particular reason? Thanks!

 

[MickG]

The array that's returned comes back as a One dimentional array, and if you don't transpose it, you will just get the first values repeated for the size of the array, Try it !!!
You can do this which returns the results horizontally :-

Range("C1").Resize(, UBound(Ray) + 1) = Ray

 

[rharn]

Thanks for all your help so far Mick! I tried out your code and you are right indeed. However, I am getting a 'subscript out of bounds' error when I try to define the bounds of my X() array in the function. I obtain X() and Y() through a search sub that populates the cell addresses of found cells in each array depending on different search criteria. Can you take a look at my function to see if anything is wrong? Thanks in advance!

Function lnArray(X As Variant, Y As Variant) As Variant
    Dim counter1 As Long
    Dim xcount As Long
    Dim t As Long
    Dim FinalResults() As Variant
 
         For xcount = LBound(X) To UBound(X)
            On Error Resume Next
            t = Application.Match(X(xcount, 1), Y, 0)
            If Err.Number = 0 Then
                If (t > 0) Then
                    ReDim Preserve FinalResults(counter1)
                    FinalResults(counter1) = X(xcount, 1)
                    counter1 = counter1 + 1
                End If
            End If
            On Error GoTo 0
        Next xcount
 
    lnArray = FinalResults
End Function

 

[rharn]

Quick updated question as well, would the intersect method work better for my purposes? I was doing a bit of reading on the net and seems like there may be some inherent flaws with the Match function...

 

[balajayan]

Hi,

I tried out an example for 2 dimensional array in the similar example. Try this:

Sub test()

Dim X(10), Y(10), result
For i = 1 To 10
    X(i - 1) = Range("A" & i).Value
    Y(i - 1) = Range("B" & i).Value
Next

result = lnArray(X, Y)

For i = LBound(result) To UBound(result)
    MsgBox result(0, i) & " - " & result(1, i)
Next
End Sub

Function lnArray(X As Variant, Y As Variant) As Variant
    Dim counter1 As Long
    Dim xcount As Long
    Dim t As Long
    Dim FinalResults() As Variant
 
    counter1 = -1
        For xcount = LBound(X) To UBound(X)
On Error Resume Next
            t = 0
            t = WorksheetFunction.Match(X(xcount), Y, 0)
On Error GoTo 0
                If (t > 0) Then
                    counter1 = counter1 + 1
                    ReDim Preserve FinalResults(1, counter1)
                    FinalResults(0, counter1) = X(xcount)
                    FinalResults(1, counter1) = t
                End If
        Next xcount
 
    lnArray = FinalResults
End Function

 

[rharn]

balajayan, the example that Mick provided works fine. However, when I try to integrate the example with my pre-existing code I run in the the 'subscript out of bound' error.

 

[balajayan]

Please try to compare the model what you have and the example that is available and see where you are going wrong. If it is similar system will not give error.

One observation: if you are using two dimensional array with following code

ReDim Preserve FinalResults(counter1, 2)

then you will get error. Instead you have to use:

ReDim Preserve FinalResults(2, counter1)

Let us know if we can do help you out in anyway to resolve your issue.