vba subscript error

UPDATE: I have been reading some websites and forums about passing arrays between subs and functions. But it got me thinking about whether my variable declarations were the problem? Currently all of my arrays (Results1,2,3,FinalResults, X & Y) are all being declared as variant. And I think this may cause a problem when passing arrays between functions. Anyone know if this problem will pertain to my code? ALso, just to clarify I want the values in Results1,2,3 to pass into the function.

I keep getting 'subscript out of range' when I try to run the following function in VBA. Both X and Y are 1-dimensional arrays that I am trying to merge data into a new array. The error occurs when I try to specify the lower and upper bounds for array X.

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 = 0
    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
                counter1 = counter1 + 1
                ReDim Preserve FinalResults(counter1)
                FinalResults(counter1) = X(xcount, 1)
            End If
        End If
        On Error GoTo 0
    Next xcount

lnArray = FinalResults
End Function

Update - This is the current code I have right now, I've made a few corrections. Namely making sure the arrays are passed to the function by reference and changed everything into a 1-dimensional array. However the same problem still persists. I've checked and my Results1() and Results2() array both store values but it is not being passed to my UDF X() and Y() variable. I included the portion of the code in my sub that passes the function, please take a look.

Sub search()
Dim Results1() As Variant, Results2() As Variant, FinalResults() As Variant

        FinalResults = lnArray(Results1, Results2)
End Sub

Function lnArray(ByRef X() As Variant, ByRef Y() As Variant) As Variant
Dim counter1 As Long
Dim xcount As Long
Dim t As Long
Dim FinalResults() As Variant

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

lnArray = FinalResults
End Function

Edit - The following is how I populate data for my Results1() and Results2() array. Please let me know if more information is required.

Sub Search()

Dim TextBox1 As Long
Dim TextBox3 As Long
Dim Results1() As Variant
Dim Results2() As Variant
Dim FindRange1 As Range
Dim Find1 As Range
Dim FindRange2 As Range
Dim Find2 As Range
Dim i1 As Long
Dim i2 As Long

TextBox1 = ILsearch.TextBox1.Value
TextBox3 = ILsearch.TextBox3.Value

 Set FindRange1 = Worksheets("Properties").Range("P7:P1000")
            If ILsearch.P1B1.Value = True Then
                For Each Find1 In FindRange1
                    If (Find1.Value < TextBox1) And (Find1.Value > 0) Then
                        i1 = i1 + 1
                        ReDim Preserve Results1(i1)
                        Results1(i1) = Find1.Address
                    End If
                Next Find1
            End If

 Set FindRange2 = Worksheets("Properties").Range("P7:P1000")
            If ILsearch.P2B1.Value = True Then
                For Each Find2 In FindRange2
                    If (Find2.Value < TextBox3) And (Find2.Value > 0) Then
                        i2 = i2 + 1
                        ReDim Preserve Results2(i2)
                        Results2(i2) = Find2.Address
                    End If
                Next Find2
            End If
End Sub

Edit2 - This is currently how I'm choosing which arrays to consolidate and display in my results. I have 3 search variables (Results1,2 and 3) and if only 1 is selected, displaying it is easy. However depending on which variables are selected I also need to consolidate the arrays (1+2,1+3,2+3, or all 3 arrays) . I realize how cluttered it is and inefficient it probably is but I could not come up with a better way.

'For a single property selection
Dim p1results As Range
Dim shProperties As Worksheet
Dim shSearchResult As Worksheet

Set shProperties = ActiveWorkbook.Worksheets("properties")
Set shSearchResult = ActiveWorkbook.Worksheets("searchresult")

If (ILsearch.ComboBox1.Enabled = True) And (ILsearch.ComboBox2.Enabled = False) And (ILsearch.ComboBox3.Enabled = False) Then
   On Error Resume Next
   For i1 = LBound(Results1) To UBound(Results1)
        Set NextRow = shSearchResult.Cells(shSearchResult.Rows.Count, 4).End(xlUp).Offset(1, -3)
        shProperties.Range(Results1(i1)).EntireRow.Copy NextRow
    Next i1
End If

'repeat same if/then code for Results2 and Results3

Dim FinalResults() As Variant
Dim FinCount As Integer
Dim Counter1 As Long
Dim t As Long

If (ILsearch.ComboBox1.Enabled = True) And (ILsearch.ComboBox2.Enabled = True) And (ILsearch.ComboBox2.Enabled = False) Then
    If IsArrayAllocated(Results1) = True And IsArrayAllocated(Results2) = True Then
    Else
         Debug.Print "Empt开发者_Python百科y Array"
    End If

    FinalResults = lnArray(Results1, Results2)
        On Error Resume Next
        For FinCount = LBound(FinalResults) To UBound(FinalResults)
            Set NextRow = shSearchResult.Cells(shSearchResult.Rows.Count, 4).End(xlUp).Offset(1, -3)
            shProperties.Range(Results3(i3)).EntireRow.Copy NextRow
        Next FinCount
End If
'repeat same if/then for (1+3) arrangement and (2+3)arrangement

Dim intResults() As Variant

If (ILsearch.ComboBox1.Enabled = True) And (ILsearch.ComboBox2.Enabled = True) And (ILsearch.ComboBox2.Enabled = True) Then
intResults = lnArray(Results1, Results2)
FinalResults = lnArray(intResults, Results3)
    On Error Resume Next
    For FinCount = LBound(FinalResults) To UBound(FinalResults)
        Set NextRow = shSearchResult.Cells(shSearchResult.Rows.Count, 4).End(xlUp).Offset(1, -3)
        shProperties.Range(Results3(i3)).EntireRow.Copy NextRow
    Next FinCount
End If

There is a mixed message in your code:

You state, and your line of code For xcount = LBound(X) To UBound(X) expects 1 dimensional arrays

But, Application.Match(X(xcount, 1), Y, 0) implies two or more dimensions (the , 1 bit). This is supported by the error, which will be returned if X is in fact two dimensional.

When the code runs and errors, examine X in the watch window to determine its true form

EDIT see Phydaux's comment - LBound(X) defaults to dimension 1 of a multi-dimensional array.

EDIT2

Two potential issues:

If either P1B1 or P2B1 = FALSE, or no matches are found in the data, then Results1 or Results2 respectively are never dimensioned. Calling LBound or UBound on a undimensioned array will cause the error

Believe it or not, calling X(xcount, 1) on a one dimensional array errors. But since On Error Resume Next is active, the error is not reported.

So, you need to:

• Handle the case where X or Y are not dimensioned

• Drop the ,1 from X(xcount, 1)

I suggest you look at Chip Pearson's excellent site for array handling code

Sounds like X is not an array: try showing the VBE Locals window to see what X really is

programming with on error resume next may be difficult to debug. This part of the code will only work for one error occurence.

For xcount = LBound(X) To UBound(X)
    On Error Resume Next
    t = 0
    t = Application.Match(X(xcount), Y, 0)
    If Err.Number = 0 Then
        If (t > 0) Then

When the first error occur the If Err.Number = 0 will fail for all of the remaining iterations. To avoid this, you should reset error with Err.clear

For xcount = LBound(X) To UBound(X)
    On Error Resume Next
    t = 0
    t = Application.Match(X(xcount), Y, 0)
    If Err.Number <> 0 Then 
        Err.clear 'ignore match error
    Else
        If (t > 0) Then

Finally you can extend this approach by adding logging before Err.Clear for example:

debug.print Err.number,Err.message....

To check if your match worked, you'd better use :

t = Application.Match(X(xcount, 1), Y, 0)
If IsEmpty(t) Then
   counter1 = counter1 + 1
End If

Depending if you need also to test if your t > 0

EDIT: The problem appears to be that the function could be called when the arrays are not allocated. This could happen if there are no matches or if ILsearch.P1B1.Value = False or ILsearch.P2B1.Value = False.

I've added a function which checks if the arrays are allocated

Sub Search()

Dim TextBox1 As Long
Dim TextBox3 As Long
Dim Results1() As Variant
Dim Results2() As Variant
Dim FindRange1 As Range
Dim Find1 As Range
Dim FindRange2 As Range
Dim Find2 As Range
Dim i1 As Long
Dim i2 As Long

TextBox1 = ILsearch.TextBox1.Value
TextBox3 = ILsearch.TextBox3.Value

 Set FindRange1 = Worksheets("Properties").Range("P7:P1000")
            If ILsearch.P1B1.Value = True Then
                For Each Find1 In FindRange1
                    If (Find1.Value < TextBox1) And (Find1.Value > 0) Then
                        i1 = i1 + 1
                        ReDim Preserve Results1(i1)
                        Results1(i1) = Find1.Address
                    End If
                Next Find1
            End If

 Set FindRange2 = Worksheets("Properties").Range("P7:P1000")
            If ILsearch.P2B1.Value = True Then
                For Each Find2 In FindRange2
                    If (Find2.Value < TextBox3) And (Find2.Value > 0) Then
                        i2 = i2 + 1
                        ReDim Preserve Results2(i2)
                        Results2(i2) = Find2.Address
                    End If
                Next Find2
            End If
If IsArrayAllocated(Results1) = True And _
    IsArrayAllocated(Results2) = True Then
    Z = lnArray(Results1, Results2)
Else
    Debug.Print "Empty Array"
End If
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 = 0
    For xcount = LBound(X) To UBound(X)
        On Error Resume Next
        t = 0
        t = Application.Match(X(xcount), Y, 0)
            If (t > 0) Then
                counter1 = counter1 + 1
                ReDim Preserve FinalResults(counter1)
                FinalResults(counter1) = X(xcount)
        End If
        On Error GoTo 0
    Next xcount

lnArray = FinalResults
End Function

Function IsArrayAllocated(Arr As Variant) As Boolean
'**Determines whether an array is allocated to avoid UBound errors
    On Error Resume Next
    IsArrayAllocated = IsArray(Arr) And _
                       Not IsError(LBound(Arr, 1)) And _
                       LBound(Arr, 1) <= UBound(Arr, 1)
    On Error GoTo 0
End Function