Hi Folks,
I would really apprecoiate it if someone could help me with the error. I have been looking at it for days now and i cannot get past it at all.
I have workbooks and in 1 of the workbooks is a userform which contains the code below.
The userform calls and finds an order that was processed earlier and then copies the details from an archive sheet and then pastes them to another worksheet which is then printed.
At the moment the userform finds the order but wont allow me to continue. It gives me the error message:
and then it highlights this part of the code:
I have double checked all the obvious things like the workbook/sheet names and both workbooks are always open. Howvere this has lost me.
I would really apprecaite any help in solving this. If you need me to send the workbooks then let me know.
Here is the full code contained in the userform:
Thanks
I would really apprecoiate it if someone could help me with the error. I have been looking at it for days now and i cannot get past it at all.
I have workbooks and in 1 of the workbooks is a userform which contains the code below.
The userform calls and finds an order that was processed earlier and then copies the details from an archive sheet and then pastes them to another worksheet which is then printed.
At the moment the userform finds the order but wont allow me to continue. It gives me the error message:
- Runtime 1004 apllication defined or object ddefined error
and then it highlights this part of the code:
Code:
Set rSearch = Workbooks("Team Leader.xls").Worksheets("QC Check Sheet Archive").Range("C5", Range("C65536").End(xlUp))I would really apprecaite any help in solving this. If you need me to send the workbooks then let me know.
Here is the full code contained in the userform:
Thanks
Code:
Dim MyArray()
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("QC Check Sheet Archive").Select
Set rSearch = Workbooks("Team Leader.xls").Worksheets("QC Check Sheet Archive").Range("C5", Range("C65536").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 = 284
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, -2).Value, "DD MMMM YYYY") 'Date
MyArray(1, i) = c.Offset(0, -1).Value 'Shift
MyArray(2, i) = c.Offset(0, 1).Value 'Operator
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
Workbooks("Beck.xls").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("QC Check Sheet Archive").Range("C:C")
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
End If
End With
FindAllButton_Click 'Runs the FindAll Button
End Sub
Private Sub PrintButton_Click()
Dim wsFrom As String
Dim wsDest1 As String, wsDest2 As String
Dim CellsToCopy1, CellsToCopy2, Dest1, Dest2
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("QC Check Sheet Archive")
wsDest1 = Workbooks("Team Leader.xls").Worksheets("Quality Control Checks RePrint")
wsDest2 = Workbooks("Team Leader.xls").Worksheets("Disc Reconciliation RePrint")
'QC Check Sheet Archive************************************************************************
CellsToCopy1 = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", _
"N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", _
"AA", "AB", "AC", "AD")
'Disc Reconciliation Sheet**************************************************************************
'Camera Count Starts at A, Finishes at CC & End of Job Starts at CE, Finishes at EB
CellsToCopy2 = Array("AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", _
"AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", _
"BB", "BC", "BD", "BE", "BF", "BG", "BH", "BI", "BJ", "BK", "BL", _
"BM", "BN", "BO", "BP", "BQ", "BR", "BS", "BT", "BU", "BV", "BW", _
"BX", "BY", "BZ", "CA", "CB", "CC", _
"CE", "CF", "CG", "CH", "CI", "CJ", "CK", "CL", "CM", "CN", "CO", _
"CP", "CQ", "CR", "CS", "CT", "CU", "CV", "CW", "CX", "CY", "CZ", _
"DA", "DB", "DC", "DD", "DE", "DF", "DG", "DH", "DI", "DJ", "DK", _
"DL", "DM", "DN", "DO", "DP", "DQ", "DR", "DS", "DT", "DU", "DV", _
"DW", "DX", "DY", "DZ", "EA", "EB", "ED")
'Quality Control Checks RePrint*********************************************************************
Dest1 = Array("B1", "D1", "B2", "D2", "B3", "B4", "C5", "C6", "C7", "D7", "C8", "D8", "C10", _
"C11", "D11", "E11", "C13", "C14", "C15", "D15", "E15", "C17", "C18", "D18", "E18", "C20", _
"C21", "C22", "C23", "A33") ' << this corresponds to CellsToCopy1
'Disc Reconciliation RePrint************************************************************************
'Camera Count Starts at B31, Finishes at K35 & End of Job Starts at B39, Finishes at K39
Dest2 = Array("B31", "B32", "B33", "B34", "B35", "C31", "C32", "C33", "C34", "C35", "D31", _
"D32", "D33", "D34", "D35", "E31", "E32", "E33", "E34", "E35", "F31", "F32", _
"F33", "F34", "F35", "G31", "G32", "G33", "G34", "G35", "H31", "H32", "H33", _
"H34", "H35", "I31", "I32", "I33", "I34", "I35", "J31", "J32", "J33", "J34", _
"J35", "K31", "K32", "K33", "K34", "K35", _
"B39", "B40", "B41", "B42", "B43", "C39", "C40", "C41", "C42", "C43", "D39", _
"D40", "D41", "D42", "D43", "E39", "E40", "E41", "E42", "E43", "F39", "F40", _
"F41", "F42", "F43", "G39", "G40", "G41", "G42", "G43", "H39", "H40", "H41", _
"H42", "H43", "I39", "I40", "I41", "I42", "I43", "J39", "J40", "J41", "J42", _
"J43", "K39", "K40", "K41", "K42", "K43", "E27") ' << this corresponds to CellsToCopy2
'***************************************************************************************************
For i = LBound(Dest1) To UBound(Dest1)
Sheets(wsDest1).Range(Dest1(i)) = _
Sheets(wsFrom).Range(CellsToCopy1(i) & RowRef)
Next
For i = LBound(Dest2) To UBound(Dest2)
Sheets(wsDest2).Range(Dest2(i)) = _
Sheets(wsFrom).Range(CellsToCopy2(i) & RowRef)
Next
'Worksheets("Quality Control Checks RePrint").PrintOut Copies:=1, Collate:=True 'Prints the Worksheets
'Worksheets("Disc Reconciliation RePrint").PrintOut Copies:=1, Collate:=True
'**************************************************************************
Dim QCCR As Worksheet
Dim DRR As Worksheet
Set QCCR = Workbooks("Team Leader.xls").Worksheets("Quality Control Checks RePrint")
Set DRR = Workbooks("Team Leader.xls").Worksheets("Disc Reconciliation RePrint")
QCCR.Range("B1:B4").ClearContents
QCCR.Range("D1:D2").ClearContents
QCCR.Range("C5:E7").ClearContents
QCCR.Range("C8:C9").ClearContents
QCCR.Range("D8:D9").ClearContents
QCCR.Range("E8:E9").ClearContents
QCCR.Range("C10:E10").ClearContents
QCCR.Range("C11:C12").ClearContents
QCCR.Range("D11:D12").ClearContents
QCCR.Range("E11:E12").ClearContents
QCCR.Range("C13:C14").ClearContents
QCCR.Range("D13:D14").ClearContents
QCCR.Range("E13:E14").ClearContents
QCCR.Range("C15:C16").ClearContents
QCCR.Range("D15:D16").ClearContents
QCCR.Range("E15:E16").ClearContents
QCCR.Range("C17:E17").ClearContents
QCCR.Range("C18:C19").ClearContents
QCCR.Range("D18:D19").ClearContents
QCCR.Range("E18:E19").ClearContents
QCCR.Range("C20:E23").ClearContents
QCCR.Range("A33:E33").ClearContents
'**********************************
DRR.Range("B31:K35").ClearContents 'Camera Count Box
DRR.Range("B39:K43").ClearContents 'End OF Job Box
DRR.Range("E27").ClearContents 'HandOver Sentence Box
'**************************************************************************
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
