userform editing & listbox issue

[kelvin_9]

i have a userform with
-around 10-15 textbook to enter employee info
-1 text box to search the employee info by enter their ID
-1 listbox to show some of their info, not all
I have some stuck with my code below like:
when I search a employee, the listbox show all possibilities, by clicking the one I want in the listbox, it's always stuck with the first one instead of the one I really wanted(eg, i want the third one in the listbox)
secondly, sometimes if i want to edit(means save) after modified, I got an error #91 .
Thanks for pointing me to the right way always

COMMAND ON EDIT

Private Sub cmdEdit_Click()
'declare the variables
    Dim findvalue As Range
    'error handling
    On Error GoTo errHandler:
    'check for values
    If reg1.Value = "" Or reg2.Value = "" Then
        MsgBox "There is no data to edit"
        Exit Sub
    End If
    'edit the row
    Set findvalue = Sheet2.Range("D:D").Find(What:=reg4, LookIn:=xlValues).Offset(0, -3)
    'if the edit is a name then add it
    Me.reg3.Value = Me.reg1.Value + ", " + Me.reg2.Value
    
    For X = 1 To cNum
        findvalue = Me.Controls("Reg" & X).Value
        Set findvalue = findvalue.Offset(0, 1)
    Next
    'refresh the listbox
    Lookup
    'error block
    On Error GoTo 0
    Exit Sub
errHandler:
    MsgBox "An Error has Occurred  " & vbCrLf & _
           "The error number is:  " & Err.Number & vbCrLf & _
           Err.Description & vbCrLf & "Please notify the administrator"
End Sub

COMMAND ON LISTBOX

Private Sub lstLookup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'declare the variables
    Dim cPayroll As String
    Dim I As Integer
    Dim findvalue
    'error block
    On Error GoTo errHandler:
    'get the select value from the listbox
    For I = 0 To lstlookup.ListCount - 1
        If lstlookup.Selected(I) = True Then
            cPayroll = lstlookup.List(I, 1)
        End If
    Next I
    'find the payroll number


Set findvalue = Sheet2.Range("C:C").Find(What:=cPayroll, LookIn:=xlValues)
If findvalue Is Nothing Then
   MsgBox cPayroll & " not found"
   Exit Sub
Else
   Set findvalue = findvalue.Offset(, -2)
End If


    'add the database values to the userform
    cNum = 13
    For X = 1 To cNum
        Me.Controls("Reg" & X).Value = findvalue
        Set findvalue = findvalue.Offset(0, 1)
    Next
    'disable adding
    Me.cmdadd.Enabled = False
    Me.cmdedit.Enabled = True
    'error block
    On Error GoTo 0
    Exit Sub
errHandler::
    MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _
           & Err.Number & vbCrLf & Err.Description & vbCrLf & _
           "Please notify the administrator"
End Sub

COMMAND ON SEARCH

Sub Lookup()
'declare the variables
    Dim rngFind As Range
    Dim strFirstFind As String
    'error statement
    On Error GoTo errHandler:
    'clear the listbox
    lstlookup.Clear
    'look up parts or all of full mname
    With Sheet2.Range("D:D")
        Set rngFind = .Find(txtlookup.Text, LookIn:=xlValues, lookat:=xlPart)
        'if value found then set a variable for the address
        If Not rngFind Is Nothing Then
            strFirstFind = rngFind.Address
            'add the values to the listbox
            Do
                If rngFind.Row > 1 Then
                    lstlookup.AddItem rngFind.Value
                    lstlookup.List(lstlookup.ListCount - 1, 1) = rngFind.Offset(0, -1)
                    lstlookup.List(lstlookup.ListCount - 1, 2) = rngFind.Offset(0, 1)
                    lstlookup.List(lstlookup.ListCount - 1, 3) = rngFind.Offset(0, 2)
                    lstlookup.List(lstlookup.ListCount - 1, 4) = rngFind.Offset(0, 4)
                    lstlookup.List(lstlookup.ListCount - 1, 5) = rngFind.Offset(0, 5)
                    lstlookup.List(lstlookup.ListCount - 1, 6) = rngFind.Offset(0, 6)
                    lstlookup.List(lstlookup.ListCount - 1, 7) = rngFind.Offset(0, 7)
                End If
                'find the next address to add
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstFind
        End If
    End With
    'disable payroll editing
    Me.reg4.Enabled = True
    Me.cmdedit.Enabled = False
    'error block
    On Error GoTo 0
    Exit Sub
errHandler::
    MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _
           & Err.Number & vbCrLf & Err.Description & vbCrLf & _
           "Please notify the administrator"
End Sub

 

[kelvin_9]

anyone got idea on my issue? please

 

[dmt32]

anyone got idea on my issue? please

As yours is a large project its sometimes difficult to test code posted - may get more responses if you could place copy of your workbook with sample data in a dropbox & provide link to it here.

Dave

 

[kelvin_9]

thanks dave, here is my template
<dl style="box-sizing: inherit; margin-right: 0px; margin-bottom: 1.5em; margin-left: 0px; color: rgb(51, 51, 51); font-family: Arial, Helvetica, sans-serif; background-color: rgb(252, 252, 252);"><dd id="direct-dl-link" style="box-sizing: inherit; margin: 0px 0px 0.8em; padding: 0px; color: rgb(34, 34, 34);">http://kel.ddns.net/f/f64066a641/?raw=1</dd></dl>

 

[dmt32]

thanks dave, here is my template
<dl style="box-sizing: inherit; margin-right: 0px; margin-bottom: 1.5em; margin-left: 0px; color: rgb(51, 51, 51); font-family: Arial, Helvetica, sans-serif; background-color: rgb(252, 252, 252);"><dd id="direct-dl-link" style="box-sizing: inherit; margin: 0px 0px 0.8em; padding: 0px; color: rgb(34, 34, 34);">http://kel.ddns.net/f/f64066a641/?raw=1</dd></dl>

for those that may be able to assist, some sample data included that relates to issues you are having would also be very helpful

Dave

 

[kelvin_9]

thanks dave, when i select Leon in the list box by searching"0"
i edit his ID with ending "7", i got #91

 

[Trixterz]

I found what was causing your error and provided a fix for it. The issue was that your look for a staff ID that does not exist because you changed it in reg4.

Use this code to replace that one in your registration form.

Option Explicit
'Private variables
Dim cNum As Integer


'############# NEW CODED ADDED ##############
'Save active records to memory.
Dim ActiveRecord As Integer
'############ ADDED CODED ENDED #############


Dim X As Integer


Private Sub cmdAdd_Click()
    Dim nextrow As Range
    'error handler
    On Error GoTo errHandler:
    'set the next row in the database
    Set nextrow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    'check for values in the first 4 controls
    For X = 1 To 4
        If Me.Controls("Reg" & X).Value = "" Then
            MsgBox "You must add all data"
            Exit Sub
        End If
    Next
    'check for duplicate payroll numbers
    If WorksheetFunction.CountIf(Sheet2.Range("D:D"), Me.reg4.Value) > 0 Then
        MsgBox "This cast member already exists"
        Exit Sub
    End If
    'number of controls to loop through
    cNum = 13
    'add the data to the database
    For X = 1 To cNum
        nextrow = Me.Controls("Reg" & X).Value
        Set nextrow = nextrow.Offset(0, 1)
    Next
    'clear the controls
    For X = 1 To cNum
        Me.Controls("Reg" & X).Value = ""
    Next
    'sort the database
    Sortit
    'error block
    On Error GoTo 0
    Exit Sub
errHandler::
    MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _
           & Err.Number & vbCrLf & Err.Description & vbCrLf & _
           "Please notify the administrator"
End Sub
Private Sub cmdClose_Click()
    Unload Me
End Sub
Private Sub cmdData_Click()
    Sheet2.Select
End Sub
Private Sub cmdLookup_Click()
    Lookup
End Sub
Sub Lookup()
'declare the variables
    Dim rngFind As Range
    Dim strFirstFind As String
    'error statement
    On Error GoTo errHandler:
    'clear the listbox
    lstlookup.Clear
    'look up parts or all of full mname
    With Sheet2.Range("D:D")
        Set rngFind = .Find(txtlookup.Text, LookIn:=xlValues, lookat:=xlPart)
        'if value found then set a variable for the address
        If Not rngFind Is Nothing Then
            strFirstFind = rngFind.Address
            'add the values to the listbox
            Do
                If rngFind.Row > 1 Then
                    lstlookup.AddItem rngFind.Value
                    lstlookup.List(lstlookup.ListCount - 1, 1) = rngFind.Offset(0, -1)
                    lstlookup.List(lstlookup.ListCount - 1, 2) = rngFind.Offset(0, 1)
                    lstlookup.List(lstlookup.ListCount - 1, 3) = rngFind.Offset(0, 2)
                    lstlookup.List(lstlookup.ListCount - 1, 4) = rngFind.Offset(0, 4)
                    lstlookup.List(lstlookup.ListCount - 1, 5) = rngFind.Offset(0, 5)
                    lstlookup.List(lstlookup.ListCount - 1, 6) = rngFind.Offset(0, 6)
                    lstlookup.List(lstlookup.ListCount - 1, 7) = rngFind.Offset(0, 7)
                End If
                'find the next address to add
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstFind
        End If
    End With
    'disable payroll editing
    Me.reg4.Enabled = True
    Me.cmdedit.Enabled = False
    'error block
    On Error GoTo 0
    Exit Sub
errHandler::
    MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _
           & Err.Number & vbCrLf & Err.Description & vbCrLf & _
           "Please notify the administrator"
End Sub
Private Sub cmdReset_Click()
'clear the Reg controls
cNum = 13
    For X = 1 To cNum
        Me.Controls("Reg" & X).Value = ""
    Next
    'enable adding new staff
    Me.cmdadd.Enabled = True
    'enable adding new payroll number
    Me.reg4.Enabled = True
    'clear the listbox
    lstlookup.Clear
    'clear the textbox
    Me.txtlookup.Value = ""
End Sub


Private Sub lstLookup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'declare the variables
    Dim cPayroll As String
    Dim I As Integer
    Dim findvalue
    'error block
    On Error GoTo errHandler:
    'get the select value from the listbox
    For I = 0 To lstlookup.ListCount - 1
        If lstlookup.Selected(I) = True Then
            cPayroll = lstlookup.List(I, 1)
        End If
    Next I
    'find the payroll number


Set findvalue = Sheet2.Range("C:C").Find(What:=cPayroll, LookIn:=xlValues)
If findvalue Is Nothing Then
   MsgBox cPayroll & " not found"
   Exit Sub
Else
   Set findvalue = findvalue.Offset(, -2)
   
   '############# NEW CODED ADDED ##############
   'Remembers the row in sheet 2 that is currently being displayed.
   ActiveRecord = findvalue.Row
   '############ ADDED CODED ENDED #############
   
End If


    'add the database values to the userform
    cNum = 13
    For X = 1 To cNum
        Me.Controls("Reg" & X).Value = findvalue
        Set findvalue = findvalue.Offset(0, 1)
    Next
    'disable adding
    Me.cmdadd.Enabled = False
    Me.cmdedit.Enabled = True
    'error block
    On Error GoTo 0
    Exit Sub
errHandler::
    MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _
           & Err.Number & vbCrLf & Err.Description & vbCrLf & _
           "Please notify the administrator"
End Sub
Private Sub cmdDelete_Click()
'declare the variables
    Dim findvalue As Range
    Dim cDelete As VbMsgBoxResult
    'check for values
    If reg1.Value = "" Or reg2.Value = "" Then
        MsgBox "There is no data to delete"
        Exit Sub
    End If
    'give the user a chance to change their mind
    cDelete = MsgBox("Are you sure that you want to delete this cast member?", vbYesNo + vbDefaultButton2, "Are you sure????")
    If cDelete = vbYes Then
        'delete the row
        Set findvalue = Sheet2.Range("D:D").Find(What:=reg4, LookIn:=xlValues)
        findvalue.EntireRow.Delete
    End If
    'clear the controls
    For X = 1 To cNum
        Me.Controls("Reg" & X).Value = ""
    Next
    'refresh the listbox
    Lookup
End Sub
Private Sub cmdEdit_Click()
'declare the variables
    Dim findvalue As Range
    'error handling
    On Error GoTo errHandler:
    'check for values
    If reg1.Value = "" Or reg2.Value = "" Then
        MsgBox "There is no data to edit"
        Exit Sub
    End If
    
    '############# NEW CODED ADDED ##############
    'Updates the record with the current staff ID if the ID has been changed.
    If Sheet2.Range("D" & ActiveRecord).Value <> reg4 Then Sheet2.Range("D" & ActiveRecord).Value = reg4
    '############# NEW CODED ADDED ##############
    
    'edit the row
    Set findvalue = Sheet2.Range("D:D").Find(What:=reg4, LookIn:=xlValues).Offset(0, -3)
    'if the edit is a name then add it
    Me.reg3.Value = Me.reg1.Value + ", " + Me.reg2.Value
    
    For X = 1 To cNum
        findvalue = Me.Controls("Reg" & X).Value
        Set findvalue = findvalue.Offset(0, 1)
    Next
    'refresh the listbox
    Lookup
    'error block
    On Error GoTo 0
    Exit Sub
errHandler:
    MsgBox "An Error has Occurred  " & vbCrLf & _
           "The error number is:  " & Err.Number & vbCrLf & _
           Err.Description & vbCrLf & "Please notify the administrator"
End Sub
Private Sub Reg2_Change()
'get the full name
    Me.reg3.Value = Me.reg1.Value + ", " + Me.reg2.Value
End Sub

 

[kelvin_9]

i did it but i still stuck with " '00 "

 

[Trixterz]

Can you be more specific?

 

[kelvin_9]

Can you be more specific?

sorry for the typo
when i search "0" and select on Leon Wong, i add "12345" as his POS and nth change in other fields
ID will also be edited