Results 1 to 6 of 6

VB search

This is a discussion on VB search within the Excel Questions forums, part of the Question Forums category; Hi Guys, I have created a form in VB and have borrowed some code for a search function from another ...

  1. #1
    New Member
    Join Date
    Oct 2013
    Posts
    8

    Default VB search

    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

  2. #2
    Board Regular adam087's Avatar
    Join Date
    Jun 2010
    Location
    So'ton, UK
    Posts
    1,184

    Default Re: VB search

    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
    Adam James
    Enthusiastic Amateur
    Excel 2010 (32-Bit) | Win 7 (64-Bit)

    Track me down on LinkedIn, should you so desire.

    Useful posting advice for which I take no credit:
    Post a screen shot with one of these: Excel Jeanie, MrExcel HTML Maker, Boders-Copy-Paste.
    If posting VBA code, please use Code Tags - like this [code]Paste your code here[/code] - more details here.

  3. #3
    New Member
    Join Date
    Oct 2013
    Posts
    8

    Default Re: VB search

    Runtime Error 424

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

  4. #4
    Board Regular adam087's Avatar
    Join Date
    Jun 2010
    Location
    So'ton, UK
    Posts
    1,184

    Default Re: VB search

    ws is not defined as anything.

    Probably need something like...
    Code:
    Dim ws as WorkSheet
    Set ws = ActiveSheet

    /AJ
    Adam James
    Enthusiastic Amateur
    Excel 2010 (32-Bit) | Win 7 (64-Bit)

    Track me down on LinkedIn, should you so desire.

    Useful posting advice for which I take no credit:
    Post a screen shot with one of these: Excel Jeanie, MrExcel HTML Maker, Boders-Copy-Paste.
    If posting VBA code, please use Code Tags - like this [code]Paste your code here[/code] - more details here.

  5. #5
    New Member
    Join Date
    Oct 2013
    Posts
    8

    Default Re: VB search

    now getting runtime error 1004

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

  6. #6
    Board Regular adam087's Avatar
    Join Date
    Jun 2010
    Location
    So'ton, UK
    Posts
    1,184

    Default Re: VB search

    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
    Adam James
    Enthusiastic Amateur
    Excel 2010 (32-Bit) | Win 7 (64-Bit)

    Track me down on LinkedIn, should you so desire.

    Useful posting advice for which I take no credit:
    Post a screen shot with one of these: Excel Jeanie, MrExcel HTML Maker, Boders-Copy-Paste.
    If posting VBA code, please use Code Tags - like this [code]Paste your code here[/code] - more details here.

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com