Search Code Deciphering Help!!

limeister

New Member
Joined
Feb 2, 2010
Messages
19
Hello All

Thanks for helping me out before. I was wondering if you could help me understand this piece of code I am trying to use.

I have a database that uses a userform to enter data. I am trying to decipher the search function I found on the internet so I can integrate it with my code but I can't seem to get it to work properly.

I can understand most of the parts but not all of them. The "FIND" function was easy enough to decipher and it works well BUT I can't seem to get the "FINDALL" function to work. It is annoying.

The "FINDALL" function searches for multiple instances of a search term and then displays all of them. Since it is a database of names and addresses, there are instances where the name "John" appears more than once.

Can someone look through the code and help explain the "FINDALL" bits?
It is supposed to list the search results in a listbox but the listbox is always empty. Perhaps I am using the wrong ranges? I'm stuck.

Thanks in advance.

If anyone has a better search code then I would really appreciate it.


Code:
'---------------------------------------------------------------------------------------
' Module    : Database Form
' DateTime  : 31/08/2005 10:55. Updatede 08-02-08
' Author    : Roy Cox
' Purpose   : Data entry form for Excel, with Search facility
'---------------------------------------------------------------------------------------
Option Explicit
Dim MyArray(6, 4)
Public MyData As Range, c As Range
Dim rFound     As Range
Dim r          As Long
Dim rng        As Range
Const frmMax   As Long = 320
Const frmHt    As Long = 210
Private Sub cmbAdd_Click()
    'next empty cell in column A
    Set c = Range("a65536").End(xlUp).Offset(1, 0)
    Application.ScreenUpdating = False    'speed up, hide task
    'write userform entries to database
    c.Value = Me.TextBox1.Value
    c.Offset(0, 1).Value = Me.TextBox2.Value
    c.Offset(0, 2).Value = Me.TextBox3.Value
    c.Offset(0, 3).Value = Me.TextBox4.Value
    'clear the form
    With Me
        .TextBox1.Value = vbNullString
        .TextBox2.Value = vbNullString
        .TextBox3.Value = vbNullString
        .TextBox4.Value = vbNullString
    End With
    Application.ScreenUpdating = True
End Sub
Private Sub cmbDelete_Click()
    Dim msgResponse As String    'confirm delete
    Application.ScreenUpdating = False
    'get user confirmation
    msgResponse = MsgBox("This will delete the selected record. Continue?", _
                         vbCritical + vbYesNo, "Delete Entry")
    Select Case msgResponse    'action dependent on response
        Case vbYes
            'c has been selected by Find button
            Set c = ActiveCell
            c.EntireRow.Delete    'remove entry by deleting row
            'restore form settings
            With Me
                .cmbAmend.Enabled = False    'prevent accidental use
                .cmbDelete.Enabled = False    'prevent accidental use
                .cmbAdd.Enabled = True    'restore use
                'clear form
                .TextBox1.Value = vbNullString
                .TextBox2.Value = vbNullString
                .TextBox3.Value = vbNullString
                .TextBox4.Value = vbNullString
            End With
        Case vbNo
            Exit Sub    'cancelled
    End Select
    Application.ScreenUpdating = True
End Sub
Private Sub cmbFind_Click()
    Dim strFind, FirstAddress As String   'what to find
    Dim rSearch As Range  'range to search
    Set rSearch = Sheet1.Range("a6", Range("a65536").End(xlUp))
    strFind = Me.TextBox1.Value    'what to look for
    Dim f      As Integer
    With rSearch
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then    'found it
            c.Select
            With Me    'load entry to form
                .TextBox2.Value = c.Offset(0, 1).Value
                .TextBox3.Value = c.Offset(0, 2).Value
                .TextBox4.Value = c.Offset(0, 3).Value
                .cmbAmend.Enabled = True     'allow amendment or
                .cmbDelete.Enabled = True    'allow record deletion
                .cmbAdd.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
                MsgBox "There are " & f & " instances of " & strFind
                Me.Height = frmMax
            End If
        Else: MsgBox strFind & " not listed"    'search failed
        End If
    End With
End Sub
Private Sub cmbAmend_Click()
    Application.ScreenUpdating = False
If rng Is Nothing Then GoTo skip
    For Each c In rng
        If r = 0 Then c.Select
        r = r - 1
    Next c
skip:
    Set c = ActiveCell
    c.Value = Me.TextBox1.Value          ' write amendments to database
    c.Offset(0, 1).Value = Me.TextBox2.Value
    c.Offset(0, 2).Value = Me.TextBox3.Value
    c.Offset(0, 3).Value = Me.TextBox4.Value
    'restore Form
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        .TextBox1.Value = vbNullString
        .TextBox2.Value = vbNullString
        .TextBox3.Value = vbNullString
        .TextBox4.Value = vbNullString
        .Height = frmHt
    End With
    If Sheet1.AutoFilterMode Then Sheet1.ShowAllData
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub
Sub cmbFindAll_Click()
    Dim strFind As String    'what to find
    Dim rFilter As Range     'range to search
    Set rFilter = Sheet1.Range("a8", Range("d65536").End(xlUp))
    Set rng = Sheet1.Range("a7", Range("a65536").End(xlUp))
    strFind = Me.TextBox1.Value
    With Sheet1
        If Not .AutoFilterMode Then .Range("A8").AutoFilter
        rFilter.AutoFilter Field:=1, Criteria1:=strFind
        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, 2).Value
                .List(.ListCount - 1, 3) = c.Offset(0, 3).Value
            End With
        Next c
    End With
End Sub
Private Sub cmbLast_Click()
    Dim LastCl As Range
    Set LastCl = Range("a65536").End(xlUp)    'last used cell in column A
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        .TextBox1.Value = LastCl.Value
        .TextBox2.Value = LastCl.Offset(0, 1).Value
        .TextBox3.Value = LastCl.Offset(0, 2).Value
        .TextBox4.Value = LastCl.Offset(0, 3).Value
    End With
End Sub
Private Sub cmbSelect_Click()
    If Me.ListBox1.ListIndex = -1 Then    'not selected
        MsgBox " No selection made"
    ElseIf Me.ListBox1.ListIndex >= 0 Then    'User has selected
        r = Me.ListBox1.ListIndex
        With Me
            .TextBox1.Value = ListBox1.List(r, 0)
            .TextBox2.Value = ListBox1.List(r, 1)
            .TextBox3.Value = ListBox1.List(r, 2)
            .TextBox4.Value = ListBox1.List(r, 3)
            .cmbAmend.Enabled = True      'allow amendment or
            .cmbDelete.Enabled = True     'allow record deletion
            .cmbAdd.Enabled = False       'don't want duplicate
        End With
    End If
End Sub
Private Sub cmnbFirst_Click()
    Dim FirstCl As Range
    'first data Entry
    Set FirstCl = Range("a1").End(xlDown).Offset(1, 0)    'allow for rows being added deleted above header row
    With Me
        .cmbAmend.Enabled = False
        .cmbDelete.Enabled = False
        .cmbAdd.Enabled = True
        .TextBox1.Value = FirstCl.Value
        .TextBox2.Value = FirstCl.Offset(0, 1).Value
        .TextBox3.Value = FirstCl.Offset(0, 2).Value
        .TextBox4.Value = FirstCl.Offset(0, 3).Value
    End With
End Sub
Private Sub UserForm_Deactivate()
    Sheet1.ShowAllData
End Sub
Private Sub UserForm_Initialize()
    Set MyData = Sheet1.Range("a5").CurrentRegion   'database
    With Me
        .Caption = "Database Example"    'userform caption
        .Height = frmHt
    End With
 
End Sub
 

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

limeister

New Member
Joined
Feb 2, 2010
Messages
19
No worries. I managed to decipher the bits I needed. The find, find all and select bits all work now.

Thanks for the views at least. A comment perhaps next time? :)
 

Watch MrExcel Video

Forum statistics

Threads
1,108,655
Messages
5,524,131
Members
409,561
Latest member
ay123

This Week's Hot Topics

Top