Private Sub cmdFind_Click()
'Set Variables
Dim strFind As String 'what to find
Dim FirstAddress As String
Dim rSearch As Range 'range to search
Set rSearch = Sheets("FraudTracker").Range("a2", Range("a65536").End(xlUp)) 'Search from the last row up till cell A2 is reached
Dim f As Integer 'Number or records returned in search
imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
'Search for the data in the MemberNumber Text Box
strFind = Me.tbMemNum.Value
With rSearch
'Search all rows for strFind
Set c = .Find(strFind, LookIn:=xlValues)
'If data is found load the rest of that row into the form
If Not c Is Nothing Then
c.Select
'Loads Form
'TextBox.Value is the Text Box to be populated
'c.Offset(0, X).Value means from column A, offset X number if cells
'Column A is (0, 0). Column B is (0, 1). Column F is (0, 5). Etc.
With Me
.tbMemNum.Value = c.Value
.tbDate1.Value = c.Offset(0, 1).Value
.cboIssueType.Value = c.Offset(0, 2).Value
.cboIssueReportedBy.Value = c.Offset(0, 3).Value
.tbDateIssue.Value = c.Offset(0, 4).Value
.cboIssueStatus.Value = c.Offset(0, 5).Value
.tbSource.Value = c.Offset(0, 6).Value
.tbOpenDate.Value = c.Offset(0, 7).Value
.tbEnrollMeth.Value = c.Offset(0, 8).Value
.cboUI.Value = c.Offset(0, 9).Value
.FName.Caption = c.Offset(0, 10).Value
.LName.Caption = c.Offset(0, 11).Value
.Address.Caption = c.Offset(0, 12).Value
.City.Caption = c.Offset(0, 13).Value
.State.Caption = c.Offset(0, 14).Value
.Zip.Caption = c.Offset(0, 15).Value
.tbFraud.Value = c.Offset(0, 16).Value
.tbBonusPt.Value = c.Offset(0, 17).Value
.tbGoldPt.Value = c.Offset(0, 18).Value
.tbOtherPt.Value = c.Offset(0, 19).Value
.tbPtsRedeemed.Value = c.Offset(0, 20).Value
.tbPoint.Value = c.Offset(0, 21).Value
.tbDollar.Value = c.Offset(0, 22).Value
.cboSiteID.Value = c.Offset(0, 23).Value
.tbSummary.Value = c.Offset(0, 28).Value
.cboCredit.Value = c.Offset(0, 29).Value
.tbCrAmt.Value = c.Offset(0, 30).Value
.tbCrDate.Value = c.Offset(0, 31).Value
.cmdEdit.Enabled = True 'allow for record to be amended
.cmdClose.Enabled = True 'allow record deletion
.cmdAdd.Enabled = True 'allow for new record to be created
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 multiple entries are found, return a message box to aleart the user
If f > 1 Then
Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")
'If user clicks OK, exceute the FindAll function
Case vbOK
FindAll
'If user clicks Cancel, exit out of this funciton
Case vbCancel
End Select
Me.Height = 750
End If
'If no matching data is found, pop up a message box to inform the user
Else: MsgBox strFind & " not listed" 'search failed
End If
End With
If Sheets("FraudTracker").AutoFilterMode Then Sheets("FraudTracker").Range("A2").AutoFilter
End Sub
'**************************************************************************************
'FindAll Function
'Finds all records matching the search from Search by Name and returns them to a List Box
'**************************************************************************************
Sub FindAll()
'Set Variables
Dim strFind As String 'what to find
Dim rFilter As Range 'range to search
Dim c As Range, a() As String, n As Long, I As Long
Set rFilter = Sheets("FraudTracker").Range("A2", Range("a65536").End(xlUp))
Set rng = Sheets("FraudTracker").Range("A2", Range("a65536").End(xlUp))
strFind = Me.tbMemNum.Value 'Search value is MemberNumber
With Sheet1
If Not .AutoFilterMode Then .Range("A2").AutoFilter
rFilter.AutoFilter Field:=1, Criteria1:="*" & strFind & "*"
Set rng = rng.Cells.SpecialCells(xlCellTypeVisible)
'Clear any data currently in the List Box
Me.ListBox1.Clear
'For each found entry return columns 0 to 32
For Each c In rng
n = n + 1: ReDim Preserve a(0 To 32, 0 To n)
For I = 0 To 32
a(I, n) = c.Offset(, I).Value
Next
Next
End With
'For each record found, enter it into the List Box
If n > 0 Then Me.ListBox1.Column = a
End Sub
'ListBox Function
'Takes the data found between the search function and the FindAll function and inserts
'the basic data into a List Box where a user can then select the proper record to edit or delete
Private Sub ListBox1_Click()
'Checks that there is data to be entered into the listbox.
'If there isn't it pops up a message box
If Me.ListBox1.ListIndex = -1 Then 'not selected
MsgBox " No selection made"
'If data is found, the populate the List Box
ElseIf Me.ListBox1.ListIndex >= 1 Then 'User has selected
r = Me.ListBox1.ListIndex
'TextBox.Value is the Text Box where the data is coming from
'ListBox1.List(r, X) is the cell in the List Box data is entered into
'Column A is (r, 0). Column B is (r, 1). Column F is (r, 5). Etc.
'r equals the row of the List Box data is being entered into.
With Me
.tbDate1.Value = ListBox1.List(r, 1)
.cboIssueType.Value = ListBox1.List(r, 2)
.cboIssueReportedBy.Value = ListBox1.List(r, 3)
.tbDateIssue.Value = ListBox1.List(r, 4)
.cboIssueStatus.Value = ListBox1.List(r, 5)
.tbSource.Value = ListBox1.List(r, 6)
.tbMemNum.Value = ListBox1.List(r, 0)
.tbOpenDate.Value = ListBox1.List(r, 7)
.tbEnrollMeth.Value = ListBox1.List(r, 8)
.cboUI.Value = ListBox1.List(r, 9)
.FName.Caption = ListBox1.List(r, 10)
.LName.Caption = ListBox1.List(r, 11)
.Address.Caption = ListBox1.List(r, 12)
.City.Caption = ListBox1.List(r, 13)
.State.Caption = ListBox1.List(r, 14)
.Zip.Caption = ListBox1.List(r, 15)
.tbFraud.Value = ListBox1.List(r, 16)
.tbBonusPt.Value = ListBox1.List(r, 17)
.tbGoldPt.Value = ListBox1.List(r, 18)
.tbOtherPt.Value = ListBox1.List(r, 19)
.tbPtsRedeemed.Value = ListBox1.List(r, 20)
.tbPoint.Value = ListBox1.List(r, 21)
.tbDollar.Value = ListBox1.List(r, 22)
.cboSiteID.Value = ListBox1.List(r, 23)
.tbSummary.Value = ListBox1.List(r, 28)
.cboCredit.Value = ListBox1.List(r, 29)
.tbCrAmt.Value = ListBox1.List(r, 30)
.tbCrDate.Value = ListBox1.List(r, 31)
.cmdEdit.Enabled = True 'Allow for Amendment by Name
.cmdClose.Enabled = True 'Allow for record Deletion
.cmdAdd.Enabled = True 'Allow to add a new record
End With
'move to the next row of the List Box
r = r - 1
End If
End Sub
LinkBack URL
About LinkBacks
Register To Reply
Originally Posted by LONeillSSC
Bookmarks