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.
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
