Excel: Userform, Search Existing Records

[ShabanaHafiz]

I have a userform in Excel Workbook in which user can add new employee records and browse existing records. Data is stored in EmployeesData worksheet in the same workbook. This sheet is hidden and the workbook is protected.

To browse existing records, user can click cmdFirst, cmdPrevious, cmdNext and cmdLast. There is a textbox, txtRowNumber between First,Previous and Next,Last buttons. Number in text box shows the row number of displayed record in EmployeesData worksheet.

The GetData routine is located in the module associated with the user form. GetData copies the data from the EmployeesData worksheet to the user form. The RowNumber text box contains the number of the row that should be displayed on the form, so the real trick is to convert the value in the RowNumber text box into a value that can be used to extract the data from the worksheet using the Cells method. Program listing of GetData is as follows:

Private Sub GetData()

Dim r As Long

If IsNumeric(txtRowNumber.Text) Then
    r = CLng(txtRowNumber.Text)
    
Else
    ClearData
    MsgBox "Illegal row number"
    Exit Sub
    
End If

If r > 1 And r <= LastRow Then
    txtEmployeeNumber.Text = Worksheets("EmployeesData").Cells(r, 1)
    txtEffDate.Text = FormatDateTime(Worksheets("EmployeesData").Cells(r, 2), vbShortDate)
    txtName.Text = Worksheets("EmployeesData").Cells(r, 3)
    cboJobTitle.Text = Worksheets("EmployeesData").Cells(r, 4)
    cboWorkLocation.Text = Worksheets("EmployeesData").Cells(r, 5)
    txtLeaveEncash.Text = Format(Worksheets("EmployeesData").Cells(r, 15), "##,##")
    txtOvertime.Text = Format(Worksheets("EmployeesData").Cells(r, 16), "##,##")
    txtLoan.Text = Format(Worksheets("EmployeesData").Cells(r, 17), "##,##")
    txtMonthlyTax.Text = Format(Worksheets("EmployeesData").Cells(r, 18), "##,##")
    txtBasicSalary.Text = Format(Worksheets("EmployeesData").Cells(r, 6), "##,##")
    txtHouseRent.Text = Format(Worksheets("EmployeesData").Cells(r, 7), "##,##")
    txtConveyance.Text = Format(Worksheets("EmployeesData").Cells(r, 8), "##,##")
    txtUtility.Text = Format(Worksheets("EmployeesData").Cells(r, 9), "##,##")
txtGrossSalary.Text = Format(Worksheets("EmployeesData").Cells(r, 14), "##,##")

    DisableSave
    cmdAdd.Enabled = True
ElseIf r = 1 Then
    ClearData

Else
    ClearData
    MsgBox "Invalid row number"
    
End If

End Sub

Code for cmdAdd_Click is as follows:

Private Sub cmdAdd_Click()
EnableSave
LastRow = FindLastRow
txtRowNumber.Text = FormatNumber(LastRow, 0)
cmdAdd.Enabled = False
ClearData
txtEmployeeNumber.SetFocus
End Sub

The FindLastRow function scans through the worksheet to find the first cell that doesn't have a value.

What I need to accomplish is whenever there is a change in txtEffdate, I need to search EmployeesData worksheet. If data exists for the composite primary key employeenumber and effective date, then the row number of that record to be assigned to txtRowNumber and then call GetData routine to populate controls on the userform.

First two columns in EmployeesData worksheet are EmployeeNumber and Effective Date and rows are sorted by these two columns.

 

[CautionMP]

ShabanaHafiz,
Here is a thought, you could use a collection to enforce your 'composite primary key employeenumber and effective date'. Note: This is typed and untested and collections are still new to me so this may be a little rough.

Global gCollection As Collection

Sub PopulateCollection()
On Error Resume Next
Dim r As Long
Set gCollection = New Collection
r = 2
Do
  gCollection.Add r, Worksheets("EmployeesData").Cells(r, 1) & ":" & _
                             FormatDateTime(Worksheets("EmployeesData").Cells(r, 2), vbShortDate)
  If Err.Number <> 0 Then
    Debug.Print "Duplicate Row: " & r
    Err.Clear
  End If
  r = r + 1
Loop Until ActiveSheet.Cells(r, 1) = ""
End Sub

Function DuplicateKey(RowNumber As Long, EmpNo As String, EffDate As String) As Boolean
On Error Resume Next
gCollection.Add RowNumber, EmpNo & ":" & EffDate
If Err.Number <> 0 Then
  DuplicateKey = True
  Err.Clear
Else
  DuplicateKey = False
  'You could add the new record here
End If
End Function

You could use it like:

Private Sub cmdAdd_Click()
EnableSave
LastRow = FindLastRow
txtRowNumber.Text = FormatNumber(LastRow, 0)
[b]If DuplicateKey(LastRow, txtEmployeeNumber.Text, txtEffDate.Text) Then
  MsgBox "Record could not be added"[/b]
  cmdAdd.Enabled = False
 ClearData
 txtEmployeeNumber.SetFocus
[b]End If[/b]
End Sub

Hope this helps,
CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)

 

[ShabanaHafiz]

Thank you.

I entered this code in the userform code with one modification in PopulateCollection Procedure:

Sub PopulateCollection()
On Error Resume Next
Dim r As Long
Set gCollection = New Collection
r = 2
Do
  gCollection.Add r, Worksheets("EmployeesData").Cells(r, 1) & ":" & _
                             FormatDateTime(Worksheets("EmployeesData").Cells(r, 2), vbShortDate)
  If Err.Number <> 0 Then
    Debug.Print "Duplicate Row: " & r
    Err.Clear
  End If
  r = r + 1
[b] Loop Until Worksheets("EmployeesData").Cells(r, 1) = ""
Debug.Print gCollection.Count [/b]
End Sub

For the test data, I have 10 rows in EmployeesData sheet. Row 1 is heading and 9 records. Immediate window showed 9 when PopulateCollection procedure reached End Sub. PopulateCollection procedure was called from txtEffDate_AfterUpdate(). What I need to accomplish is if any item of the collection matches with entered txtEmployeeNumber and txtEffdate, then assign row number of that item, which is stored in the variable r to txtRowNumber. This will trigger txtRowNumber_Change() event and that row will be populated on userform:

Private Sub txtRowNumber_Change()
GetData
End Sub

 

[CautionMP]

ShabanaHafiz,
[tt]DuplicateKey()[/tt] didn't work for you?

CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)

 

[ShabanaHafiz]

No.

Program did not enter the following two lines of code:

If Err.Number <> 0 Then  
    [b]Debug.Print "Duplicate Row: " & r
    Err.Clear[/b]
End If

gCollection.Count was 0 at the time of entering Do Loop. gCollection.Add added all 9 rows. These rows have unique EmployeeNumber and EffectiveDate combinations

 

[ShabanaHafiz]

One thing more:

cmdAdd_Click() clears the userform to add a new record. cmdSave_Click() saves/updates records. cmdAdd_Click is calling DuplicateKey.

I need to populate controls on txtEffDate_AfterUpdate(). This event is calling PopulateCollection().

 

[ShabanaHafiz]

I accomplished it. The following example code from Excel VBA help for Collection Object worked fine:

I created a Collection object (MyClasses), chose the Class Module command from the Insert menu and declared a public variable called InstanceName at module level of Class1. The following code was entered into the General section of another module and started with the statement ClassNamer in another procedure, PopulateCollection.

Sub ClassNamer()
    Dim MyClasses As New Collection    ' Create a Collection object.
    Dim Num    ' Counter for individualizing keys.
    Dim TheName, MyObject, NameList    ' Variants to hold information.
    Dim r As Long
    Dim SearchKey As String
    
    r = 2
    Do
        Dim Inst As New Class1    ' Create a new instance of Class1.
        TheName = Worksheets("EmployeesData").Cells(r, 1) & ":" & _
                    FormatDateTime(Worksheets("EmployeesData").Cells(r, 2), vbShortDate)
        Inst.InstanceName = TheName    ' Put name in object instance.
        If Left(Inst.InstanceName, 1) <> ":" Then
            ' Add the named object to the collection.
            MyClasses.Add Item:=Inst, key:=CStr(r)
        End If
        ' Clear the current reference in preparation for next one.
        Set Inst = Nothing
        r = r + 1
    Loop Until Left(TheName, 1) = ":"
    r = 1
    SearchKey = frmEmployees.txtEmployeeNumber.Text & ":" & frmEmployees.txtEffDate.Text
    For Each MyObject In MyClasses    ' Create list of names.
        r = r + 1
        If MyObject.InstanceName = SearchKey Then
            frmEmployees.txtRowNumber.Text = r
            Exit For
        End If
    Next MyObject
    For Num = 1 To MyClasses.Count    ' Remove name from the collection.
        MyClasses.Remove 1    ' Since collections are reindexed
                ' automatically, remove the first
    Next        ' member on each iteration.
End Sub

PopulateCollection procedure was called from txtEffDate_AfterUpdate:

Private Sub txtEffDate_AfterUpdate()
PopulateCollection
End Sub

CautionMP,
Thank you for mentioning about collection object to solve the problem.