userform editing & listbox issue

kelvin_9

Active Member
Joined
Mar 6, 2015
Messages
257
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
Code:
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
Code:
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
Code:
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

b588fce8f1
 

Some videos you may like

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,484
Office Version
  1. 2019
Platform
  1. Windows
anyone got idea on my issue? please:eek:

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

Active Member
Joined
Mar 6, 2015
Messages
257
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

Well-known Member
Joined
Jul 3, 2012
Messages
6,484
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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

Active Member
Joined
Mar 6, 2015
Messages
257
cba86093df


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

Trixterz

Board Regular
Joined
Aug 15, 2019
Messages
59

ADVERTISEMENT

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

Watch MrExcel Video

Forum statistics

Threads
1,127,597
Messages
5,625,729
Members
416,130
Latest member
galgozzi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top