VBA subscript out of range error

[rharn]

I am trying to create a search sub that will allow a user to search through a dataset and allow the user to select up to 3 search variables. I have been debugging my code but the problem currently is consolidating the arrays when I have more than 2 search variables and I need to return the results only present in all of the search variable arrays. Please take a look below for the code. I've simplified it to reduce space and much of it is repeatition.

[COLOR=#00008b]Sub[/COLOR] Search() 
 
[COLOR=#00008b]Dim[/COLOR] TextBox1 [COLOR=#00008b]As[/COLOR] [COLOR=#00008b]Long[/COLOR] 
[COLOR=#00008b]Dim[/COLOR] TextBox3 [COLOR=#00008b]As[/COLOR] [COLOR=#00008b]Long[/COLOR] 
[COLOR=#00008b]Dim[/COLOR] Results1() [COLOR=#00008b]As[/COLOR] [COLOR=#00008b]Variant[/COLOR] 
[COLOR=#00008b]Dim[/COLOR] Results2() [COLOR=#00008b]As[/COLOR] [COLOR=#00008b]Variant[/COLOR] 
[COLOR=#00008b]Dim[/COLOR] FindRange1 [COLOR=#00008b]As[/COLOR] Range 
[COLOR=#00008b]Dim[/COLOR] Find1 [COLOR=#00008b]As[/COLOR] Range 
[COLOR=#00008b]Dim[/COLOR] FindRange2 [COLOR=#00008b]As[/COLOR] Range 
[COLOR=#00008b]Dim[/COLOR] Find2 [COLOR=#00008b]As[/COLOR] Range 
[COLOR=#00008b]Dim[/COLOR] i1 [COLOR=#00008b]As[/COLOR] [COLOR=#00008b]Long[/COLOR] 
[COLOR=#00008b]Dim[/COLOR] i2 [COLOR=#00008b]As[/COLOR] [COLOR=#00008b]Long[/COLOR] 
 
TextBox1 = ILsearch.TextBox1.Value 
TextBox3 = ILsearch.TextBox3.Value 
 
 [COLOR=#00008b]Set[/COLOR] FindRange1 = Worksheets([COLOR=#800000]"Properties"[/COLOR]).Range([COLOR=#800000]"P7:P1000"[/COLOR]) 
            [COLOR=#00008b]If[/COLOR] ILsearch.P1B1.Value = [COLOR=#800000]True[/COLOR] [COLOR=#00008b]Then[/COLOR] 
                [COLOR=#00008b]For[/COLOR] [COLOR=#00008b]Each[/COLOR] Find1 [COLOR=#00008b]In[/COLOR] FindRange1 
                    [COLOR=#00008b]If[/COLOR] (Find1.Value < TextBox1) [COLOR=#00008b]And[/COLOR] (Find1.Value > [COLOR=#800000]0[/COLOR]) [COLOR=#00008b]Then[/COLOR] 
                        i1 = i1 + [COLOR=#800000]1[/COLOR] 
                        [COLOR=#00008b]ReDim[/COLOR] [COLOR=#00008b]Preserve[/COLOR] Results1(i1) 
                        Results1(i1) = Find1.Address 
                    [COLOR=#00008b]End[/COLOR] [COLOR=#00008b]If[/COLOR] 
                [COLOR=#00008b]Next[/COLOR] Find1 
            [COLOR=#00008b]End[/COLOR] [COLOR=#00008b]If[/COLOR] 
 
 [COLOR=#00008b]Set[/COLOR] FindRange2 = Worksheets([COLOR=#800000]"Properties"[/COLOR]).Range([COLOR=#800000]"P7:P1000"[/COLOR]) 
            [COLOR=#00008b]If[/COLOR] ILsearch.P2B1.Value = [COLOR=#800000]True[/COLOR] [COLOR=#00008b]Then[/COLOR] 
                [COLOR=#00008b]For[/COLOR] [COLOR=#00008b]Each[/COLOR] Find2 [COLOR=#00008b]In[/COLOR] FindRange2 
                    [COLOR=#00008b]If[/COLOR] (Find2.Value < TextBox3) [COLOR=#00008b]And[/COLOR] (Find2.Value > [COLOR=#800000]0[/COLOR]) [COLOR=#00008b]Then[/COLOR] 
                        i2 = i2 + [COLOR=#800000]1[/COLOR] 
                        [COLOR=#00008b]ReDim[/COLOR] [COLOR=#00008b]Preserve[/COLOR] Results2(i2) 
                        Results2(i2) = Find2.Address 
                    [COLOR=#00008b]End[/COLOR] [COLOR=#00008b]If[/COLOR] 
                [COLOR=#00008b]Next[/COLOR] Find2 
            [COLOR=#00008b]End[/COLOR] [COLOR=#00008b]If[/COLOR] 
 
[COLOR=#00008b]'Repeat above code block for a 3rd find range and a 3rd results array (Results3())[/COLOR]
 
[COLOR=#00008b]'To display the arrays I've used a series if if/then statements depending on which combobox (search variable) was chosen[/COLOR]
[COLOR=#00008b][COLOR=#808080]'For a single property selection[/COLOR] 
 
Dim p1results As Range 
Dim shProperties As Worksheet 
Dim shSearchResult As Worksheet 
 
Set shProperties = ActiveWorkbook.Worksheets([COLOR=#800000]"properties"[/COLOR]) 
Set shSearchResult = ActiveWorkbook.Worksheets([COLOR=#800000]"searchresult"[/COLOR]) 
 
If (ILsearch.ComboBox1.Enabled = [COLOR=#800000]True[/COLOR]) And (ILsearch.ComboBox2.Enabled = [COLOR=#800000]False[/COLOR]) And (ILsearch.ComboBox3.Enabled = [COLOR=#800000]False[/COLOR]) Then 
   On Error Resume Next 
   For i1 = LBound(Results1) To UBound(Results1) 
        Set NextRow = shSearchResult.Cells(shSearchResult.Rows.Count, [COLOR=#800000]4[/COLOR]).End(xlUp).Offset([COLOR=#800000]1[/COLOR], -[COLOR=#800000]3[/COLOR]) 
        shProperties.Range(Results1(i1)).EntireRow.Copy NextRow 
    Next i1 
End If 
 
[COLOR=#808080]'repeat same if/then code for Results2 and Results3[/COLOR] 
 
Dim FinalResults() As Variant 
Dim FinCount As Integer 
Dim Counter1 As Long 
Dim t As Long 
 
If (ILsearch.ComboBox1.Enabled = [COLOR=#800000]True[/COLOR]) And (ILsearch.ComboBox2.Enabled = [COLOR=#800000]True[/COLOR]) And (ILsearch.ComboBox2.Enabled = [COLOR=#800000]False[/COLOR]) Then 
    If IsArrayAllocated(Results1) = [COLOR=#800000]True[/COLOR] And IsArrayAllocated(Results2) = [COLOR=#800000]True[/COLOR] Then 
    Else 
         Debug.Print [COLOR=#800000]"Empty Array"[/COLOR] 
    End If 
 
    FinalResults = lnArray(Results1, Results2) 
        On Error Resume Next 
        For FinCount = LBound(FinalResults) To UBound(FinalResults) 
            Set NextRow = shSearchResult.Cells(shSearchResult.Rows.Count, [COLOR=#800000]4[/COLOR]).End(xlUp).Offset([COLOR=#800000]1[/COLOR], -[COLOR=#800000]3[/COLOR]) 
            shProperties.Range(Results3(i3)).EntireRow.Copy NextRow 
        Next FinCount 
End If 
[COLOR=#808080]'repeat same if/then for results array (1+3) arrangement and (2+3)arrangement[/COLOR] 
 
Dim intResults() As Variant 
 
If (ILsearch.ComboBox1.Enabled = [COLOR=#800000]True[/COLOR]) And (ILsearch.ComboBox2.Enabled = [COLOR=#800000]True[/COLOR]) And (ILsearch.ComboBox2.Enabled = [COLOR=#800000]True[/COLOR]) 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, [COLOR=#800000]4[/COLOR]).End(xlUp).Offset([COLOR=#800000]1[/COLOR], -[COLOR=#800000]3[/COLOR]) 
        shProperties.Range(Results3(i3)).EntireRow.Copy NextRow 
    Next FinCount 
End If 
End[/COLOR] [COLOR=#00008b]Sub[/COLOR] 
 
'This function is supposed to consolidate the arrays if more than 1 search variable was selected
[COLOR=#00008b]Function[/COLOR] lnArray([COLOR=#00008b]ByRef[/COLOR] X() [COLOR=#00008b]As[/COLOR] [COLOR=#00008b]Variant[/COLOR], [COLOR=#00008b]ByRef[/COLOR] Y() [COLOR=#00008b]As[/COLOR] [COLOR=#00008b]Variant[/COLOR]) [COLOR=#00008b]As[/COLOR] [COLOR=#00008b]Variant[/COLOR] 
[COLOR=#00008b]Dim[/COLOR] counter1 [COLOR=#00008b]As[/COLOR] [COLOR=#00008b]Long[/COLOR] 
[COLOR=#00008b]Dim[/COLOR] xcount [COLOR=#00008b]As[/COLOR] [COLOR=#00008b]Long[/COLOR] 
[COLOR=#00008b]Dim[/COLOR] t [COLOR=#00008b]As[/COLOR] [COLOR=#00008b]Long[/COLOR] 
[COLOR=#00008b]Dim[/COLOR] FinalResults() [COLOR=#00008b]As[/COLOR] [COLOR=#00008b]Variant[/COLOR] 
 
counter1 = [COLOR=#800000]0[/COLOR] 
    [COLOR=#00008b]For[/COLOR] xcount = LBound(X) [COLOR=#00008b]To[/COLOR] UBound(X) 
        [COLOR=#00008b]On[/COLOR] [COLOR=#00008b]Error[/COLOR] [COLOR=#00008b]Resume[/COLOR] [COLOR=#00008b]Next[/COLOR] 
        t = [COLOR=#800000]0[/COLOR] 
        t = Application.Match(X(xcount), Y, [COLOR=#800000]0[/COLOR]) 
        [COLOR=#00008b]If[/COLOR] Err.Number = [COLOR=#800000]0[/COLOR] [COLOR=#00008b]Then[/COLOR] 
            [COLOR=#00008b]If[/COLOR] (t > [COLOR=#800000]0[/COLOR]) [COLOR=#00008b]Then[/COLOR] 
                counter1 = counter1 + [COLOR=#800000]1[/COLOR] 
                [COLOR=#00008b]ReDim[/COLOR] [COLOR=#00008b]Preserve[/COLOR] FinalResults(counter1) 
                FinalResults(counter1) = X(xcount) 
            [COLOR=#00008b]End[/COLOR] [COLOR=#00008b]If[/COLOR] 
        [COLOR=#00008b]End[/COLOR] [COLOR=#00008b]If[/COLOR] 
        [COLOR=#00008b]On[/COLOR] [COLOR=#00008b]Error[/COLOR] [COLOR=#00008b]GoTo[/COLOR] [COLOR=#800000]0[/COLOR] 
    [COLOR=#00008b]Next[/COLOR] xcount 
 
lnArray = FinalResults 
[COLOR=#00008b]End[/COLOR] [COLOR=#00008b]Function[/COLOR]

My error occurs in the lnArray function when I try to define the bounds of xcount "For xcount = LBound(X) To UBound(X)". The error says my subscript is out of range. However when I look at the Watch window, there are values for Results1() and Results2() arrays but they do not get passed correctly to X() and Y() array in lnArray respectively. Can anyone offer any explanations as to why? I am out of ideas and dont know how to proceed anymore

 

[NdNoviceHlp]

I'm guessing. There's a bunch of messed up stuff. HTH. Dave

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
                        Exit For
                    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
                        Exit For
                    End If
                Next Find2
            End If
 
'Repeat above code block for a 3rd find range and a 3rd results array (Results3())
 
'To display the arrays I've used a series if if/then statements depending on which combobox (search variable) was chosen
'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)
   For i1 = LBound(Results1(i1)) To UBound(Results1(i1))
   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 "Empty Array"
    End If
  '   FinalResults = lnArray(Results1, Results2)

    FinalResults = lnArray(Results1(i1), Results2(i2))
        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 results array (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
End Sub
 
'This function is supposed to consolidate the arrays if more than 1 search variable was selected
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: dimming TextBox1 as variable is bad

 

[rharn]

well the sub works fine if i am only displaying 1 variable searches, but when I try to incorporate more variables to search for at the same time that's when I start getting problems. I've dimmed all of my arrays as variant and I was wondering if this is going to affect it when i am passing the arrays between the functions?