Cant Seem To Run This Code

charllie · Nov 1, 2005

Hi Folks,

I am trying to run this code once a number has been entered into the textbox "AuthorisationTextBox". It should find and match the number. but i keep getting the runtime error 1004 application defined and then this part of code highlights:

Code:

Set rSearch = Workbooks("Team Leader.xls").Worksheets("Time Sheet Archive").Range("B6", Range("B65536").End(xlUp))

Can anyone help/guide me to the error please?

Here is the full code:

Code:

Dim MyArray()

Private Sub AuthorisationTextBox_Change()

    If Me.AuthorisationTextBox.Value = "50" Then 'Authorisation for Mike
        Me.Height = 218
        Me.AuthorisationLabel.Visible = False
        Me.AuthorisationTextBox = "Mike"
        Me.AuthorisationTextBox.Locked = True
        Me.RequestbyLabel.Visible = True
        Me.TextBox1.SetFocus
    End If
        If Me.AuthorisationTextBox.Value = "51" Then 'Authorisation for Keith
            Me.Height = 218
            Me.AuthorisationLabel.Visible = False
            Me.AuthorisationTextBox = "Keith"
            Me.AuthorisationTextBox.Locked = True
            Me.RequestbyLabel.Visible = True
            Me.TextBox1.SetFocus
        End If
    If Me.AuthorisationTextBox.Value = "52" Then 'Authorisation for Julie
        Me.Height = 218
        Me.AuthorisationLabel.Visible = False
        Me.AuthorisationTextBox = "Julie"
        Me.AuthorisationTextBox.Locked = True
        Me.RequestbyLabel.Visible = True
        Me.TextBox1.SetFocus
    End If

End Sub

Private Sub FindAllButton_Click()

    Dim FirstAddress As String
    Dim strFind As String    'what to find
    Dim rSearch As Range     'range to search
    Dim fndA, fndB, fndC As String
    Dim head1, head2, head3  As String
    Dim i As Integer, intC As Integer
    Application.ScreenUpdating = False
        'need to select QC Check Sheet Archive page,screen updating off to hide this
        'Workbooks("Team Leader.xls").Worksheets("Time Sheet Archive").Select
        Set rSearch = Workbooks("Team Leader.xls").Worksheets("Time Sheet Archive").Range("B6", Range("B65536").End(xlUp))
        strFind = Me.TextBox1.Value
        If Len(strFind) = 0 Then Exit Sub
        With rSearch
            Set c = .Find(strFind, LookIn:=xlValues)
            If Not c Is Nothing Then    'found it
                Me.Height = 348
                ReDim MyArray(3, i)
                    MyArray(0, i) = "Date"
                    MyArray(1, i) = "Shift"
                    MyArray(2, i) = "Operator"
                    i = i + 1
                FirstAddress = c.Address
                Do
                    'Load details into Listbox
                    ReDim Preserve MyArray(3, i)
                    MyArray(0, i) = Format(c.Offset(0, -1).Value, "DD MMMM YYYY") 'Date
                    MyArray(1, i) = c.Offset(0, 1).Value 'Shift
                    MyArray(2, i) = c.Offset(0, 3).Value  'Operator
                    'fndJ = Format(c.Offset(0, 9).Value, "h:mm")
                    MyArray(3, i) = c.Row   'Now storing row info to be used ref later, not showing in the listbox
                    i = i + 1
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> FirstAddress
            End If
        End With
        'Load data into LISTBOX
        With Me.ListBox1
          .Column = MyArray 'Now MyArray stores the row# of each item
        End With
        'Worksheets("HandPack Time Sheet").Select
    Application.ScreenUpdating = True

End Sub
Private Sub FindButton_Click()
    Dim strFind, FirstAddress As String   'what to find
    Dim rSearch As Range  'range to search
        Set rSearch = Workbooks("Team Leader.xls").Worksheets("Time Sheet Archive").Range("B:B")
        strFind = Me.TextBox1.Value
        If Len(strFind) = 0 Then Exit Sub
        Dim f As Integer
        With rSearch
            Set c = .Find(strFind, LookIn:=xlValues)
            If Not c Is Nothing Then    'found it
                'TextBox2 = c.Offset(0, -2).Value 'Date, Place Date in a textbox if required
                'TextBox3 = c.Offset(0, -1).Value 'Shift, Place Shift in a textbox if required
                'TextBox4 = c.Offset(0, 1).Value  'Operator, Place Operator in a textbox if required
                f = 0
                FirstAddress = c.Address
                Do
                    f = f + 1
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> FirstAddress
                 If f > 0 Then
                     MsgBox "There are " & f & " instances of Order Number " & strFind
                 End If
            Else: MsgBox " There Is No Previous Record Of Order Number " & strFind 'search failed
                Me.TextBox1 = Empty: Me.TextBox1.SetFocus
                Exit Sub 'Search Failed
            End If
        End With
        FindAllButton_Click 'Runs the FindAll Button
End Sub
Private Sub PrintButton_Click()

    Dim wsFrom As String
    Dim wsDest1 As String
    Dim CellsToCopy1, Dest1
    Dim RowRef As Long
        With Me.ListBox1
            If IsNull(.Value) Or .ListIndex = 0 Then
                MsgBox "You must select one item from the list"
                .SetFocus
                Exit Sub
            End If
            RowRef = .List(.ListIndex, 3) ' << retrieve row index of the cells that copy from
        End With
        wsFrom = Workbooks("Team Leader.xls").Worksheets("Time Sheet Archive")
        wsDest1 = Workbooks("Shift Manager.xls").Worksheets("Management Printout")
        'The two sections below match each other by rows, for example:Time Sheet Archive cell A
        '= Management Sheet cell B8.
        'Time Sheet Archive***********************************************************************
        CellsToCopy1 = Array("A", "B", "B", "C", "D", "E", "G", "H", "I", "J", "M", "N", "O", _
                            "P", "Q", "S", "S", "T", "U", "V", "X", "Y", "Z", "AA", "AB", "AC", _
                            "AD", "AE", "AF", "AG", "AH", "AJ", "AL", "AM", "AN", "AP", "AQ", _
                            "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", _
                            "BC", "BD", "BE", "BG", "BH", "BI", "BJ")
        'Management Printout**********************************************************************
        Dest1 = Array("B8", "B6", "A2", "B10", "B12", "B14", "M6", "E6", "E8", "E10", "M8", "F6", "F8", _
                            "F10", "F14", "M14", "M19", "J6", "J8", "J10", "C24", "C26", "C28", "C30", "C32", "H26", _
                            "H28", "H30", "M26", "M28", "M30", "M17", "F17", "F19", "B19", "C42", "C44", _
                            "I48", "C36", "E36", "H36", "C38", "E38", "H38", "C46", "I42", "C40", "E40", _
                            "H40", "C48", "M46", "I44", "I46", "M42", "M44") ' << this corresponds to CellsToCopy1
        '*****************************************************************************************
        For i = LBound(Dest1) To UBound(Dest1)
            Sheets(wsDest1).Range(Dest1(i)) = _
            Sheets(wsFrom).Range(CellsToCopy1(i) & RowRef)
        Next
        Workbooks("Shift Manager.xls").Worksheets("Management Printout").Range("E2") = Me.AuthorisationTextBox
        Workbooks("Shift Manager.xls").Worksheets("Management Printout").Range("I2") = Me.DateTextBox
        Workbooks("Shift Manager.xls").Worksheets("Management Printout").Range("L2") = Me.TimeTextBox
        Workbooks("Shift Manager.xls").Worksheets("Management Printout").PrintOut Copies:=1, Collate:=True 'Prints the Worksheets
        
        '*****************************************************************************************
        Dim MMPO As Worksheet
            Set MMPO = Workbooks("Shift Manager.xls").Worksheets("Management Printout")
                MMPO.Range("A2:M2").ClearContents
                MMPO.Range("B6:B12").ClearContents
                MMPO.Range("B14:C14").ClearContents
                MMPO.Range("E6:F10").ClearContents
                MMPO.Range("F14").ClearContents
                MMPO.Range("J6:J10").ClearContents
                MMPO.Range("M6:M8").ClearContents
                MMPO.Range("M14").ClearContents
                MMPO.Range("B19:C19").ClearContents
                MMPO.Range("F17:F19").ClearContents
                MMPO.Range("M17:M19").ClearContents
                MMPO.Range("C24:C32").ClearContents
                MMPO.Range("H26:H30").ClearContents
                MMPO.Range("M26:M30").ClearContents
                MMPO.Range("C36:C48").ClearContents
                MMPO.Range("E38:J38").ClearContents
                MMPO.Range("E40:J40").ClearContents
                MMPO.Range("E36:J36").ClearContents
                MMPO.Range("I42:I48").ClearContents
                MMPO.Range("M42:M46").ClearContents
        '**************************************************************************
        Me.TextBox1 = ClearContents
End Sub
Private Sub UserForm_Activate()
    Me.TimeTextBox = Format(Time, "hh:mm")       'Time
    Me.DateTextBox = Format(Date, "dd mmmm yyyy") 'Date
End Sub

wwbwb · Nov 1, 2005

Edit that line to be like this

Code:

Set rSearch = Workbooks("Team Leader.xls").Worksheets("Time Sheet Archive").Range("B6:b" & Range("B65536").End(xlUp).Row)

GlennUK · Nov 1, 2005

There's something fishy going on here .... why has the row before been commented out?

charllie · Nov 1, 2005

Hi wwbwb,

Thanks for that. Changed it as you advised and it now allows to me to find a match and then place it in the list box. I can then choose it from the listbox and press "Print" commanbutton.

However then i get "error 438 object doesn't support this property or method" and it then highlights this part of the above code:

Code:

wsFrom = Workbooks("Team Leader.xls").Worksheets("Time Sheet Archive")

Which is located in:

Code:

Private Sub PrintButton_Click()

Any ideas?

charllie · Nov 1, 2005

Hi Glenn,

If you mean:

Code:

'Workbooks("Team Leader.xls").Worksheets("Time Sheet Archive").Select

Then its because, since changing to seperate workbooks, i no longer need this and it works ok without it.

GlennUK · Nov 2, 2005

Your comment:

Then its because, since changing to seperate workbooks ...

might explain why you're getting that error:

However then i get "error 438 object doesn't support this property or method"

charllie · Nov 2, 2005

Hi Glenn,

Thanks for reply.

Yep i thought that but all other codes and userforms seem to connect ok. I have checked the code but cant seem to see any mistakes.

Not sure where to go from here.

Thanks

Charllie

GlennUK · Nov 2, 2005

Well, is there a Worksheet "Time Sheet Archive" in Workbook "Team Leader.xls"?

charllie · Nov 2, 2005

Hi Glenn,

Yea thereb is and it is used by the other workbooks with no problems at all.

Don't worry i am going to tackle this another way and get rid of this userform once and for all. For some reason it seems to be the only one that is causing errors in all workbooks.

Thanks to all for your input.

Thanks

tusharm · Nov 2, 2005

You should really take the time to understand how the Range property works. Unless the worksheet in question is the active worksheet, wwbwb's solution is guaranteed to corrupt your data.

Check XL VBA help for the Range property. Alternatively, a brief explanation is in
Case Study – Understanding code
http://www.tushar-mehta.com/excel/vba/vba-Understand code.htm

charllie said:
Hi wwbwb,

Thanks for that. Changed it as you advised and it now allows to me to find a match and then place it in the list box. I can then choose it from the listbox and press "Print" commanbutton.
{snip}

Cant Seem To Run This Code

charllie

Well-known Member

Excel Facts

wwbwb

Well-known Member

GlennUK

Well-known Member

charllie

Well-known Member

charllie

Well-known Member

GlennUK

Well-known Member

charllie

Well-known Member

GlennUK

Well-known Member

charllie

Well-known Member

tusharm

MrExcel MVP

Similar threads

Forum statistics

Share this page

Cant Seem To Run This Code

Well-known Member

Excel Facts

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock