Good Evening!
I'm so super excited that I have my form working perfectly. The only enhancement I would like to add to the form is that when the user searches for a record, the "Date" field is populated with the date reflected in the underlying data. In some instances that date can be blank in the underlying data - if the date is blank I'd like the form to populate with the current date. I believe this code would go somewhere in the "Find" code, where it loads the data to the form, but I'll be honest, I don't have a clue on how to do this. Here is a snapshot of my code:
I'm so super excited that I have my form working perfectly. The only enhancement I would like to add to the form is that when the user searches for a record, the "Date" field is populated with the date reflected in the underlying data. In some instances that date can be blank in the underlying data - if the date is blank I'd like the form to populate with the current date. I believe this code would go somewhere in the "Find" code, where it loads the data to the form, but I'll be honest, I don't have a clue on how to do this. Here is a snapshot of my code:
Code:
Private Declare Function GetSystemMetrics32 Lib "User32" _ Alias "GetSystemMetrics" (ByVal nIndex&) As Long
Dim oCtrl As MSForms.Control
Private Sub cboSource_Change()
If cboSource.Value = "Investigation" Then
tbInvestigateName.Visible = True
Me.Label52.Visible = True
End If
End Sub
Private Sub cmdAdd_Click()
Dim lRow As Long
Dim lPart As Long
Dim Ws As Worksheet
Set Ws = Worksheets("Tracker")
'find first empty row in database
lRow = Ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
'copy the data to the database
With Ws
.Cells(lRow, 1).Value = Me.tbMemNum & "- " & lRow
.Cells(lRow, 9).Value = Me.tbDate1
.Cells(lRow, 10).Value = Me.cboIssueType
.Cells(lRow, 11).Value = Me.cboIssueReportedBy
.Cells(lRow, 12).Value = Me.tbDateIssue
.Cells(lRow, 13.Value = Me.cboIssueStatus
.Cells(lRow, 14).Value = Me.cboSource
.Cells(lRow, 2).Value = Me.tbMemNum
End With
ClearControls
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub CmdClear_Click()
With Me
For Each oCtrl In .Controls
Select Case TypeName(oCtrl)
Case "TextBox": oCtrl.Value = Empty
Case "OptionButton": oCtrl.Value = False
Case "ComboBox": oCtrl.Value = Empty
Case "ListBox": oCtrl.Value = Empty
End Select
Next oCtrl
End With
With ListBox1
.Clear
.ListIndex = -1
End With
End Sub
Private Sub CmdCalc_Click()
tbDollar = tbPoint * 0.005
End Sub
Private Sub UserForm_Initialize()
Dim Factor As Single
Factor = 0.75 'adjust to suit
Me.Width = GetSystemMetrics32(0) * Factor
Me.Height = GetSystemMetrics32(1) * Factor
Dim v, e
With Sheets("Tracker").Range("B2", Range("b65536").End(xlUp))
v = .Value
End With
With CreateObject("scripting.dictionary")
.comparemode = 1
For Each e In v
If Not .exists(e) Then .Add e, Nothing
Next
If .Count Then Me.cboMemberSearch.List = Application.Transpose(.keys)
End With
Me.tbDate1 = Date
tbInvestigateName.Visible = False
Me.Label52.Visible = False
For Each cell In
[List2]
Me.cboIssueType.AddItem cell
Next cell
For Each cell In [ProgramIntegrity]
Me.cboIssueReportedBy.AddItem cell
Next cell
For Each cell In [IssueStatus]
Me.cboIssueStatus.AddItem cell
Next cell
End Sub
Private Sub tbDate1_AfterUpdate()
tbDate1.Text = Format(tbDate1.Text, "m/d/yyyy")
End Sub
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("Tracker").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.cboMemberSearch.Value
With rSearch
'Search all rows for strFind
'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.Offset(0, 1).Value
.tbDate1.Value = c.Offset(0, 8).Value
.cboIssueType.Value = c.Offset(0, 9).Value
.cboIssueReportedBy.Value = c.Offset(0, 10).Value
.tbDateIssue.Value = c.Offset(0, 11).Value
.cboIssueStatus.Value = c.Offset(0, 12).Value
.cboSource.Value = c.Offset(0, 13).Value
.cmdSave.Enabled = True 'allow for record to be amended
.cmdClose.Enabled = True 'allow record deletion
.cmdAdd.Enabled = False '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("Tracker").AutoFilterMode Then Sheets("Tracker").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("Tracker").Range("a2", Range("a65536").End(xlUp))
Set rng = Sheets("Tracker").Range("a2", Range("a65536").End(xlUp))
strFind = Me.cboMemberSearch.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
n = -1
'For each found entry return columns 0 to 34
For Each c In rng
n = n + 1: ReDim Preserve a(0 To 34, 0 To n)
For I = 0 To 34
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, 8)
.cboIssueType.Value = ListBox1.List(r, 9)
.cboIssueReportedBy.Value = ListBox1.List(r, 10)
.tbDateIssue.Value = ListBox1.List(r, 11)
.cboIssueStatus.Value = ListBox1.List(r, 12)
.cboSource.Value = ListBox1.List(r, 13)
.tbMemNum.Value = ListBox1.List(r, 1)
.cmdSave.Enabled = True 'Allow for Amendment by Name
.cmdClose.Enabled = True 'Allow for record Deletion
.cmdAdd.Enabled = False 'Allow to add a new record
End With
'move to the next row of the List Box
r = r - 1
End If
End Sub
Private Sub cmdSave_Click()
fRow = Application.Match(TextBox1.Text, Sheets("Tracker").Columns(1), 0)
If Not IsError(fRow) Then
With Sheets("Tracker")
.Cells(fRow, 2).Value = Me.tbMemNum.Value
.Cells(fRow, 9).Value = Me.tbDate1.Value
.Cells(fRow, 10).Value = Me.cboIssueType.Value
.Cells(fRow, 11).Value = Me.cboIssueReportedBy.Value
.Cells(fRow, 12).Value = Me.tbDateIssue.Value
.Cells(fRow, 13).Value = Me.cboIssueStatus.Value
.Cells(fRow, 14).Value = Me.cboSource.Value
End With
End If
ClearControls
With ListBox1
.Clear
.ListIndex = -1
End With
End Sub
Sub ClearControls()
With Me
For Each oCtrl In .Controls
Select Case TypeName(oCtrl)
Case "TextBox": oCtrl.Value = Empty
Case "OptionButton": oCtrl.Value = False
Case "ComboBox": oCtrl.Value = Empty
End Select
Next oCtrl
End With
With ListBox1
.Clear
.ListIndex = -1
End With
End Sub
