Ubound returns "subscript out of range"

[StrawS]

Hi,

I'm having trouble with one line of my project, it's the second to last line, and it generates the following error

Run-time error '9':
Subscript out of range

I think I'm using the right syntax for the Ubound command, but I'm not entirely sure. If anyone could take the time to check it out that'd be great.

Thank you



Here is my code:

Private Sub CommandButton1_Click()
    Dim dr As Range, ff As String, a(), n As Long, i As Integer
    If TextBox7.Text <> "" And TextBox7.Text <> "dd/mm/yyyy" Then
        If ComboBox1.Text = Sheets("Invoice").Range("O25").Value Then
            For Each Cell In Sheets("database").Range("A2:" & Sheets(database).Cells(65536, 1).End(xlUp).Address)
                If Cell.Value = TextBox7.Text Then
                    n = UBound(a, 2) + 1
                    ReDim Preserve a(1 To 8, 1 To n)
                    a(1, n) = Cell.Row
                End If
            Next
        ElseIf ComboBox1.Text = Sheets("Invoice").Range("O26").Value Then
            For Each Cell In Sheets("database").Range("A2:" & Sheets(database).Cells(65536, 1).End(xlUp).Address)
                If Cell.Value < TextBox7.Text Then
                    n = UBound(a, 2) + 1
                    ReDim Preserve a(1 To 8, 0 To n)
                    a(1, n) = Cell.Row
                End If
            Next
        ElseIf ComboBox1.Text = Sheets("Invoice").Range("O27").Value Then
            For Each Cell In Sheets("database").Range("A2:" & Sheets(database).Cells(65536, 1).End(xlUp).Address)
                If Cell.Value > TextBox7.Text Then
                    n = UBound(a, 2) + 1
                    ReDim Preserve a(1 To 8, 0 To n)
                    a(1, n) = Cell.Row
                End If
            Next
        ElseIf ComboBox1.Text = Sheets("Invoice").Range("O28").Value Then
            For Each Cell In Sheets("database").Range("A2:" & Sheets(database).Cells(65536, 1).End(xlUp).Address)
                If Cell.Value > TextBox7.Text And Cell.Value < TextBox8.Text Then
                    n = UBound(a, 2) + 1
                    ReDim Preserve a(1 To 8, 0 To n)
                    a(1, n) = Cell.Row
                End If
            Next
        End If
    End If
        
    
    If Me.TextBox6.Text <> "" Then
        With Sheets("Database")
            Set dr = .Range("C2:" & .Cells(65536, 3).End(xlUp).Address).Find(Me.TextBox6.Text, , , xlWhole)
            If Not dr Is Nothing Then
                ff = dr.Address
                Do
                    n = UBound(a, 2) + 1
                    ReDim Preserve a(1 To 8, 0 To n)
                    a(2, n) = dr.Row
                    dr = .Range("C2:" & .Cells(65536, 3).End(xlUp).Address).FindNext(dr)
                Loop Until ff = dr.Address
            End If
        End With
    End If
    
    
    If Me.TextBox5.Text <> "" Then
        With Sheets("Database")
            Set dr = .Range("D2:" & .Cells(65536, 4).End(xlUp).Address).Find(Me.TextBox5.Text, , , xlWhole)
            If Not dr Is Nothing Then
                ff = dr.Address
                Do
                    n = UBound(a, 2) + 1
                    ReDim Preserve a(1 To 8, 0 To n)
                    a(3, n) = dr.Row
                    dr = .Range("D2:" & .Cells(65536, 4).End(xlUp).Address).FindNext(dr)
                Loop Until ff = dr.Address
            End If
        End With
    End If
    
    
    If Me.TextBox4.Text <> "" Then
        With Sheets("Database")
            Set dr = .Range("F2:" & .Cells(65536, 6).End(xlUp).Address).Find(Me.TextBox4.Text, , , xlWhole)
            If Not dr Is Nothing Then
                ff = dr.Address
                Do
                    n = UBound(a, 2) + 1
                    ReDim Preserve a(1 To 8, 0 To n)
                    a(4, n) = dr.Row
                    dr = .Range("F2:" & .Cells(65536, 6).End(xlUp).Address).FindNext(dr)
                Loop Until ff = dr.Address
            End If
        End With
    End If
    
    
    If Me.ComboBox3.Text <> "" Then
        With Sheets("Database")
            Set dr = .Range("H2:" & .Cells(65536, 8).End(xlUp).Address).Find(Me.ComboBox3.Text, , , xlWhole)
            If Not dr Is Nothing Then
                ff = dr.Address
                Do
                    n = UBound(a, 2) + 1
                    ReDim Preserve a(1 To 8, 0 To n)
                    a(5, n) = dr.Row
                    dr = .Range("H2:" & .Cells(65536, 8).End(xlUp).Address).FindNext(dr)
                Loop Until ff = dr.Address
            End If
        End With
    End If
    
    
    If Me.TextBox3.Text <> "" Then
        With Sheets("Database")
            Set dr = .Range("I2:" & .Cells(65536, 45).End(xlUp).Address).Find(Me.TextBox3.Text, , , xlWhole)
            If Not dr Is Nothing Then
                ff = dr.Address
                Do
                    n = UBound(a, 2) + 1
                    ReDim Preserve a(1 To 8, 0 To n)
                    a(6, n) = dr.Row
                    dr = .Range("I2:" & .Cells(65536, 45).End(xlUp).Address).FindNext(dr)
                Loop Until ff = dr.Address
            End If
        End With
    End If
    
    
    If Me.TextBox2.Text <> "" Then
        With Sheets("Database")
            Set dr = .Range("DP2:" & .Cells(65536, 120).End(xlUp).Address).Find(Me.TextBox2.Text, , , xlWhole)
            If Not dr Is Nothing Then
                ff = dr.Address
                Do
                    n = UBound(a, 2) + 1
                    ReDim Preserve a(1 To 8, 0 To n)
                    a(7, n) = dr.Row
                    dr = .Range("DP2:" & .Cells(65536, 120).End(xlUp).Address).FindNext(dr)
                Loop Until ff = dr.Address
            End If
        End With
    End If
    
    
    If TextBox1.Text <> "" Then
        If ComboBox2.Text = Sheets("Invoice").Range("O20").Value Then
            For Each Cell In Sheets("database").Range("DR2:" & Sheets(database).Cells(65536, 122).End(xlUp).Address)
                If Cell.Value = TextBox1.Text Then
                    n = UBound(a, 2) + 1
                    ReDim Preserve a(1 To 8, 0 To n)
                    a(8, n) = Cell.Row
                End If
            Next
        ElseIf ComboBox2.Text = Sheets("Invoice").Range("O21").Value Then
            For Each Cell In Sheets("database").Range("DR2:" & Sheets(database).Cells(65536, 122).End(xlUp).Address)
                If Cell.Value < TextBox1.Text Then
                    n = UBound(a, 2) + 1
                    ReDim Preserve a(1 To 8, 0 To n)
                    a(8, n) = Cell.Row
                End If
            Next
        ElseIf ComboBox2.Text = Sheets("Invoice").Range("O22").Value Then
            For Each Cell In Sheets("database").Range("DR2:" & Sheets(database).Cells(65536, 122).End(xlUp).Address)
                If Cell.Value > TextBox1.Text Then
                    n = UBound(a, 2) + 1
                    ReDim Preserve a(1 To 8, 0 To n)
                    a(8, n) = Cell.Row
                End If
            Next
        ElseIf ComboBox2.Text = Sheets("Invoice").Range("O23").Value Then
            For Each Cell In Sheets("database").Range("DR2:" & Sheets(database).Cells(65536, 122).End(xlUp).Address)
                If Cell.Value > TextBox1.Text And Cell.Value < TextBox9.Text Then
                    n = UBound(a, 2) + 1
                    ReDim Preserve a(1 To 8, 0 To n)
                    a(8, n) = Cell.Row
                End If
            Next
        End If
    End If
    
    
    
    
    MsgBox UBound(a, 2)
 End Sub

 

[jindon]

I'm not sure what you are after
This is only my guess

Private Sub CommandButton1_Click() 
    Dim dr As Range, ff As String, a(), n As Long, i As Integer ,txt As String

'check "First Name" field for entry, search database, enter results into array column 1 
    If Me.TextBox1.Text <> "" Then 
        With Sheets("Database") 
            Set dr = .Range("A2:" & .Cells(65536, 1).End(xlUp).Address).Find(Me.TextBox1.Text, , , xlWhole) 
            If Not dr Is Nothing Then 
                ff = dr.Address 
                Do 
                    n = n + 1 
                    ReDim Preserve a(1 To 2, 1 To n) 
                    a(1, n) = dr.Row 
                    dr = .Range("A2:" & .Cells(65536, 1).End(xlUp).Address).FindNext(dr) 
                Loop Until ff = dr.Address 
            End If 
        End With 
    End If 
    
    
'check "Last Name" field for entry, search database, enter results into array column 2 
    If Me.TextBox2.Text <> "" Then 
        With Sheets("Database") 
            Set dr = .Range("B2:" & .Cells(65536, 2).End(xlUp).Address).Find(Me.TextBox2.Text, , , xlWhole) 
            If Not dr Is Nothing Then 
                ff = dr.Address : n = 0
                Do 
                    n = n + 1
                    If n > UBound(a, 2) Then ReDim Preserve a(1 To 2, 1 To n) 
                    a(2, n) = dr.Row 
                    dr = .Range("B2:" & .Cells(65536, 2).End(xlUp).Address).FindNext(dr) 
                Loop Until ff = dr.Address 
            End If 
        End With 
    End If 
    For i = 1 To UBound(a,1)
         For ii = 1 To n
             txt = txt & a(i,ii) Chr(32)
         Next
         txt = Trim(txt) & vbLf
    Next
    MsgBox txt
    MsgBox UBound(a, 2) 
End Sub

 

[StrawS]

Very good

So I made a couple of adjustments to the code (one of which was to change the "xlwhole" section of the ".Find" commands to "xlpart") and plugged it in. However I am only getting one result from searches where I should be getting multiple results. For example:

• with "john" in textbox1 the first messagebox = "4" and the second = "1"
  with "joe" in textbox1 the first messagebox = "3" and the second = "1"
  with "Tom" in textbox1 the first messagebox = "5" and the second = "1"
  with "jo" in textbox1 the first messagebox = "3" and the second = "1"
  with "Smith" in textbox2 the first messagebox = "2" and the second = "1"
  with "th" in textbox2 the first messagebox = "6" and the second = "1"

Here is the code with my revisions

Private Sub CommandButton1_Click()
    Dim dr As Range, ff As String, a(), n As Long, i As Integer, txt As String
    ReDim a(1 To 2, 1 To 1)
'check "First Name" field for entry, search database, enter results into array column 1
    If Me.TextBox1.Text <> "" Then
        With Sheets("Database")
            Set dr = .Range("A2:" & .Cells(65536, 1).End(xlUp).Address).Find(Me.TextBox1.Text, , , xlPart)
            If Not dr Is Nothing Then
                ff = dr.Address
                Do
                    n = n + 1
                    ReDim Preserve a(1 To 2, 1 To n)
                    a(1, n) = dr.Row
                    dr = .Range("A2:" & .Cells(65536, 1).End(xlUp).Address).FindNext(dr)
                Loop Until ff = dr.Address
            End If
        End With
    End If
    
    
'check "Last Name" field for entry, search database, enter results into array column 2
    If Me.TextBox2.Text <> "" Then
        With Sheets("Database")
            Set dr = .Range("B2:" & .Cells(65536, 2).End(xlUp).Address).Find(Me.TextBox2.Text, , , xlPart)
            If Not dr Is Nothing Then
                ff = dr.Address: n = 0
                Do
                    n = n + 1
                    If n > UBound(a, 2) Then ReDim Preserve a(1 To 2, 1 To n)
                    a(2, n) = dr.Row
                    dr = .Range("B2:" & .Cells(65536, 2).End(xlUp).Address).FindNext(dr)
                Loop Until ff = dr.Address
            End If
        End With
    End If
    For i = 1 To UBound(a, 1)
         For ii = 1 To n
             txt = txt & a(i, ii) & Chr(32)
         Next
         txt = Trim(txt) & vbLf
    Next
    MsgBox txt
    MsgBox UBound(a, 2)
End Sub

 

[jindon]

Very good

So I made a couple of adjustments to the code (one of which was to change the "xlwhole" section of the ".Find" commands to "xlpart") and plugged it in. However I am only getting one result from searches where I should be getting multiple results. For example:

• with "john" in textbox1 the first messagebox = "4" and the second = "1"
  with "joe" in textbox1 the first messagebox = "3" and the second = "1"
  with "Tom" in textbox1 the first messagebox = "5" and the second = "1"
  with "jo" in textbox1 the first messagebox = "3" and the second = "1"
  with "Smith" in textbox2 the first messagebox = "2" and the second = "1"
  with "th" in textbox2 the first messagebox = "6" and the second = "1"

As I said already, the code I gave you is based on my guess and I don't know how data are layed.

Therefore, I don't understand the reason for getting such result.
Absolutely no idea.

I can't solve your problem unless you describe your problem in words.

 

[StrawS]

Hi Jindon.

I'm a bit confused.

I don't think I understand what you mean by

and I don't know how data are layed.

When we started again I posted the data for a simple spreadsheet

Lets take a database as follows:
A1 = First Name
A2 = John
A3 = Joe
A4 = John
A5 = Tom
A6 = Joe
B1 = Last Name
B2 = Smith
B3 = Blogs
B4 = Doe
B5 = Jones
B6 = Thompson

If this isn't the data you are referring to, then what do you mean?
I also posted the details for my userform, and for the code working it. I don't understand what information I have left out.




I also don't think I understand what you mean by

I can't solve your problem unless you describe your problem in words.

I thought I had done that when I said

However I am only getting one result from searches where I should be getting multiple results.

When there were a couple of minor hiccups from the code you wrote, I wasn't able to trace the problems to their source in your code, so I thought it would be best to describe the problem (as above) and post data regarding several different instances of the problem so that it would make it easy to see where the problem was coming from.


So I'm very confused at the moment.

Please tell me what i have missed or forgotten or left out.

Thank you
Straws

 

[jindon]

OK
What I mean is

Do you want to search the item that matches

1) first name only
2) first and last name together
3) first name and last name differently

Your code is suupose to do 1) ,and 3) if textbox2 is filled.

and the result for 3) will look like

row1     2 : 3 : 4 : 7 : 10
row2        :    :   :    :      :  2 : 3  : 4  : 7  : 10

(numbers are not an issue, it is how the array look like)

So I've just tried to change to look like

row1   2  :  3  :  4  :  7  :  10
row2   2  :  3  :  4  :  7  :  10

But, as you have noticed, when 3) is executed, the numbers corresponding to the column
will differ if there are same fist names and different last names etc.

If above is your intention, the code should work.

 

[StrawS]

I want the user to be able to search in any one of the following ways:
First name only
Second name only
First name and last name differently



Thanks for fixing my array structure too. When I originally compared your code to what I had in the first place I realised my silly mistake.

But, as you have noticed, when 3) is executed, the numbers corresponding to the column
will differ if there are same fist names and different last names etc.

Yes that was my intention. I want each criteria to get matches independently of each other.
Strangely though, I do get the problems I described in my last post.

Your last post may have thrown some light on the situation tho...
In your mock-drawings of the array you showed it horizontally, yet I think I have been designing it vertically. ie each ROW (rather than column) is a new match to the criteria. Perhaps this is somehow the cause of the problems.

I can't think of any other reason at the moment.

 

[jindon]

Then try

Private Sub CommandButton1_Click()
    Dim dr As Range, ff As String, a(), n As Long, i As Integer, txt As String
    ReDim a(1 To 2, 1 To 1)
'check "First Name" field for entry, search database, enter results into array column 1
    If Me.TextBox1.Text <> "" Then
        With Sheets("Database")
            Set dr = .Columns("a").Find(Me.TextBox1.Text, , , xlPart)
            If Not dr Is Nothing Then
                ff = dr.Address
                Do
                    n = n + 1
                    ReDim Preserve a(1 To 2, 1 To n)
                    a(1, n) = dr.Row
                    dr = .Columns("a").FindNext(dr)
                Loop Until ff = dr.Address
            End If
        End With
    End If
    
    
'check "Last Name" field for entry, search database, enter results into array column 2
    If Me.TextBox2.Text <> "" Then
        With Sheets("Database")
            Set dr = .Columns("b").Find(Me.TextBox2.Text, , , xlPart)
            If Not dr Is Nothing Then
                ff = dr.Address: n = 0
                Do
                    n = n + 1
                    If n > UBound(a, 2) Then ReDim Preserve a(1 To 2, 1 To n)
                    a(2, n) = dr.Row
                    dr = .Columns("b").FindNext(dr)
                Loop Until ff = dr.Address
            End If
        End With
    End If
    a = Application.Transpose(a)
    For i = 1 To UBound(a, 1)
        txt = "Row" & i & a(i,1) & vbTab & a(i,2) & vbLf
    Next
    MsgBox txt
    MsgBox UBound(a, 1)
End Sub

 

[StrawS]

uhh, I get a

run-time error '9':
subscript out of range

From reading it through I can't work out what it's doing. but I guess I'll see when we get it working.

 

[jindon]

Can you step through the code by hitting F8, so that we'll see which line
generate the error, and also can you need the value of n for me?

 

[StrawS]

Real sorry it's been so long since I've been able to post.
I've been totally snowed under with other work.

However, if you're still able to help on this thread, or still even watching, then in answer to your question:

Regardless of what I type in textbox 1 or textbox 2, I get the following results:

The fifth-to-last row was the one that generated the error.

txt = "Row" & i & a(i, 1) & vbTab & a(i, 2) & vbLf

n = 1

I'm stumped