VB search

[leedsstuart]

Hi Guys,

I have created a form in VB and have borrowed some code for a search function from another form but am having difficulty getting it to run.

Private Sub chkQuote_Click()
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdNew_Click()
For Each Ctl In Me.Controls
If TypeName(Ctl) = "TextBox" Or TypeName(Ctl) = "ComboBox" Then
Ctl.Value = ""
ElseIf TypeName(Ctl) = "CheckBox" Then
Ctl.Value = False
End If
Next Ctl
End Sub

Private Sub cmdSearch_Click()
Dim f As Integer
Dim FirstAddress As String
Dim txtEAM As String 'what to find
Dim rSearch As Range 'range to search




Set rSearch = ws.Range("A1", Range("A65000").End(xlUp))
Set Rng = ws.Range("A2", Range("A65000").End(xlUp))
Set rFilter = ws.Range("A3", Range("F65000").End(xlUp))
strFindSheet1 = Me.txtEAM.Value 'what to look for

With rSearch
Set c = .Find(strFindSheet1, LookIn:=xlValues)
If Not c Is Nothing Then 'found it
c.Select
With Me 'load entry to form
.txtEAM.Value = c.Offset(0, -1).Value
.txtPO.Value = c.Offset(0, 1).Value
.txtQR.Value = c.Offset(0, 2).Value
.txtLOC.Value = c.Offset(0, 3).Value
.txtCONT.Value = c.Offset(0, 4).Value
.txtQA.Value = c.Offset(0, 5).Value
.comFAM.Value = c.Offset(0, 6).Value
.comAUTH.Value = c.Offset(0, 7).Value
.comUL.Value = c.Offset(0, 8).Value
.txtCOM.Value = c.Offset(0, 9).Value
.cmdNEW.Enabled = False 'don't want to duplicate record
f = 0
End With
FirstAddress = c.Address
Do
f = f + 1 'count number of matching records
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
If f > 1 Then
Select Case MsgBox("There are " & f & " instances of " & strFindSheet1, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
Case vbOK
With ws
If Not .AutoFilterMode Then .Range("B3").AutoFilter 'Column to be Filtered
rFilter.AutoFilter Field:=2, Criteria1:=strFindSheet1 'What to Filter For
Set Rng = Rng.Cells.SpecialCells(xlCellTypeVisible)

Me.ListBox1.Clear
For Each c In Rng
With Me.ListBox1
.AddItem c.Value
.List(.ListCount - 1, 1) = c.Offset(0, -1).Value
.List(.ListCount - 1, 2) = c.Offset(0, 1).Value
.List(.ListCount - 1, 3) = c.Offset(0, 2).Value
.List(.ListCount - 1, 4) = c.Offset(0, 3).Value
.List(.ListCount - 1, 5) = c.Offset(0, 4).Value
.ColumnWidths = "1.1 in;2.5 in;1.1 in;2.75 in;1.25 in;5 in"
End With
Next c
End With
Case vbCancel
'do nothing
End Select
Me.Height = frmMaxH
Me.Width = frmMaxW
End If
Else: MsgBox "Can Not Find: " & strFindSheet1 'search failed
End If
End With
If Sheet1.AutoFilterMode Then Sheet1.Range("A3").AutoFilter
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If Me.ListBox1.ListIndex = -1 Then 'not selected
MsgBox "No selection made"
ElseIf Me.ListBox1.ListIndex >= 1 Then 'User has selected
r = Me.ListBox1.ListIndex
With Me
.txtPO.Value = Trim(ListBox1.List(r, 0))
.txtQR.Value = Trim(ListBox1.List(r, 1))
.txtLOC.Value = Trim(ListBox1.List(r, 2))
.txtCONT.Value = Trim(ListBox1.List(r, 3))
.txtQA.Value = Trim(ListBox1.List(r, 4))
.comFAM.Value = Trim(ListBox1.List(r, 5))
.comAUTH.Value = Trim(ListBox1.List(r, 6))
.comUL.Value = Trim(ListBox1.List(r, 7))
.cmdAdd.Enabled = True
End With
End If
End Sub
Private Sub cmdSave_Click()
Dim RowCount As Long
Dim Ctl As Control
If Me.txtEAM.Value = "" Then
MsgBox "Please enter a EAM Ref Number.", vbExclamation, "EAM Ref"
Me.txtEAM.SetFocus
Exit Sub
End If
If Me.txtPO.Value = "" Then
MsgBox "Please enter a Purchase Order Number.", vbExclamation, "PO Number"
Me.txtEAM.SetFocus
Exit Sub
End If
If Me.txtQR.Value = "" Then
MsgBox "Please enter a Quote Ref.", vbExclamation, "Quote Ref"
Me.txtEAM.SetFocus
Exit Sub
End If
If Me.txtLOC.Value = "" Then
MsgBox "Please enter a Location.", vbExclamation, "Location"
Me.txtEAM.SetFocus
Exit Sub
End If
If Me.txtCONT.Value = "" Then
MsgBox "Please enter a Contractor.", vbExclamation, "Contractor"
Me.txtEAM.SetFocus
Exit Sub
End If
If Me.txtQA.Value = "" Then
MsgBox "Please enter a Quote Amount.", vbExclamation, "Quote Amount"
Me.txtEAM.SetFocus
Exit Sub
End If
If Not IsNumeric(Me.txtQA.Value) Then
MsgBox "The Quote Amount box must contain a number.", vbExclamation, "Quote Amount"
Me.txtQA.SetFocus
Exit Sub
End If
If Not IsDate(Me.DTPicker1.Value) Then
MsgBox "The Date box must contain a date.", vbExclamation, "Date Sent For Auth"
Me.DTPicker1.SetFocus
Exit Sub
End If
If Me.comFAM.Value = "" Then
MsgBox "Please enter a Authorising FAM.", vbExclamation, "Authorising FAM"
Me.txtEAM.SetFocus
Exit Sub
End If
RowCount = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Sheet1").Range("A1")
.Offset(RowCount, 0).Value = Me.txtEAM.Value
.Offset(RowCount, 1).Value = Me.txtPO.Value
.Offset(RowCount, 2).Value = Me.txtQR.Value
.Offset(RowCount, 3).Value = Me.txtLOC.Value
.Offset(RowCount, 4).Value = Me.txtCONT.Value
.Offset(RowCount, 5).Value = Me.txtQA.Value
.Offset(RowCount, 6).Value = Me.comFAM.Value
.Offset(RowCount, 7).Value = Format(Now, "dd/mm/yyyy hh:nn:ss")
.Offset(RowCount, 8).Value = Format(Now, "dd/mm/yyyy hh:nn:ss")
.Offset(RowCount, 9).Value = Me.comAUTH.Value
.Offset(RowCount, 10).Value = Me.comUL.Value
.Offset(RowCount, 12).Value = Me.txtCOM.Value
If Me.chkQuote.Value = True Then
.Offset(RowCount, 14).Value = "Yes"
Else
.Offset(RowCount, 14).Value = "No"
End If
End With
For Each Ctl In Me.Controls
If TypeName(Ctl) = "TextBox" Or TypeName(Ctl) = "ComboBox" Then
Ctl.Value = ""
ElseIf TypeName(Ctl) = "CheckBox" Then
Ctl.Value = False
End If
Next Ctl
End Sub


Any help you can offer is gratefully accepted,


Thanks


Stu

 

[adam087]

I've honestly not looked through the code in detail, but might be useful to understand what problems are you facing? Is it running but coming back with no answers? Is it returning the wrong answer? or is it throwing an exception somewhere in the code and if so, where?


/AJ

 

[leedsstuart]

Runtime Error 424

Set rSearch = ws.Range("A1", Range("A65000").End(xlUp))

 

[adam087]

ws is not defined as anything.

Probably need something like...

Dim ws as WorkSheet
Set ws = ActiveSheet

/AJ

 

[leedsstuart]

now getting runtime error 1004

.txtEAM.Value = c.Offset(0, -1).Value

 

[adam087]

Well for a start c is not explicitly declared, would recommend you add Option Explicit to the top of your code to prevent this. Then you'll need to Dim c as Range. But to be fair that's probably not causing this error.

I think it's the fact that c is a Cell in Column A, but the offset command in the line you've highlighted asks it to look in the column to the left (which of course doesn't exist).

/AJ