Ubound returns "subscript out of range"

S

StrawS

Board Regular
Joined
Jul 31, 2006
Messages
123
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
Click to expand...

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:
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
 
Sort by date Sort by votes
Ok
This should add a new sheet and displays the result on it.
Code: 
Private Sub CommandButton1_Click()
    Dim dr As Range, ff As String, a(), n As Long, i As Integer, txt As String
    Dim ws As Worksheet
    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
    Set ws = Sheets.Add.Name = "Dummy"
    Sheets("Dummy").Range("a1").Resize(2,n).Value = a
    MsgBox txt
    MsgBox UBound(a, 2)
End Sub
 
Upvote 0

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
ok,
when text was put into textbox1, the row-number of the first match came up in cell A1 of the new sheet.

when text was put into textbox2, the row-number of the first match came up in cell A2 of the new sheet.

this was the case even when mutliple matches should've occurred.

So it seems the my code isn't looking past the first match for some reason.
 
Upvote 0
OOps!
Can you change following line?
you need to delete Dummy sheet before you run the code.
Code: 
    Sheets("Dummy").Range("a1").Resize(2,n).Value = a
To
Code: 
Sheets("Dummy").Range("a1").Resize(2,UBound(a,2)).Value= a
 
Upvote 0
OK

Can you step debugg again with Local Window open?

Go to [View]-[LocalWindow]

And as you hit F8 on the code, you can see all the variables in the Local window.

Check variable a if it stores the data that you want.
 
Upvote 0
wow! that "locals" analysis window is really cool!!
it's just what i needed.

I've tracked down what I think to be the problem
Code: 
dr = .Columns("a").FindNext(dr)
This last line of the do-loop isn't functioning properly. It doesn't seem to track to the next instance - instead, it just comes up with the original result again.

Can you double check my code on that line just to check I haven't done something silly.

Thank you.
 
Upvote 0
right
So simple.
well, glad to get it sorted.
thank you!



everything seems to work fine now. The only problem I can see with the system is that it includes the first row in the column-searches. How do I change things to exclude that first row?
 
Upvote 0
Just insert If statement like this..
Code: 
            If Not dr Is Nothing Then
                ff = dr.Address
                Do
                    If dr.Row <> 1 Then
                       n = n + 1
                       ReDim Preserve a(1 To 2, 1 To n)
                       a(1, n) = dr.Row
                    End If
                    Set dr = .Columns("a").FindNext(dr)
                Loop Until ff = dr.Address
            End If

and, of course, you need to do the same for the other Do Loop as well.
 
Upvote 0
Yeah, I guess that's the easiest way in the end.

Well. I have more questions but they should really go on their own threads.

Thanks for your seemingly endless help Jindon!
And thanks everyone else for your bits too.

Straws
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question
Function to return array of 10 largest absolute values while maintaining sign
Replies
0
Views
119
eurobonds
E
I
  • Question
Kill my file
Replies
2
Views
331
ipbr21054
I
I
  • Question
Inoice number not being saved in cell
Replies
6
Views
331
ipbr21054
I
I
  • Question
Look for value in column A then check if cell has a value
Replies
4
Views
349
ipbr21054
I
MartinS
  • Question
Update FormatConditions Shifts Column/Row Reference
Replies
0
Views
75
MartinS
MartinS

Forum statistics

Threads
1,216,051
Messages
6,128,505
Members
449,455
Latest member
jesski

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top