userform editing & listbox issue

K

kelvin_9

Active Member
Joined
Mar 6, 2015
Messages
460
Office Version
  1. 2019
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
 
Sort by date Sort by votes
If you want the zeros to show in front of the number then you need to change the number format of your cell or use the code below to replace your cmdEdit_Click sub routine in your registration form.

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
    
    'Updates the record with the current staff ID if the ID has been updated.
    If Sheet2.Range("D" & ActiveRecord).Value <> reg4 Then
        Sheet2.Range("D" & ActiveRecord).Value = reg4
        Sheet2.Range("D" & ActiveRecord).NumberFormat = "00000"  <---- Add more zeros as needed depending the length that you want.
    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
 
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Hi,
Finally found moment to look at your code & made some changes

Make backup of your workbook & replace ALL code in your form with following:

Code: 
Option Explicit
'Module level variables
Const cNum As Integer = 13
Dim x As Integer
Dim CastMember As String
Dim wsDatabase As Worksheet
Dim RowNo As Long


Private Sub cmdAdd_Click()
    Dim nextrow As Range
    Dim arr() As Variant
    
'size array
    ReDim arr(1 To cNum)
    
'error handler
    On Error GoTo errHandler
    
'check for values in the first 4 controls
    For x = 1 To cNum
        With Me.Controls("Reg" & x)
            If x < 5 And .Value = "" Then
                .SetFocus
                MsgBox "You must add all data", 48, "Entry Required"
                Exit Sub
            End If
            
'get corret data type
'note IsDate & IsNumeric functions have limitations & may not always
'produce required result
            If IsDate(.Value) Then
                arr(x) = DateValue(.Value)
            ElseIf IsNumeric(.Value) Then
                arr(x) = Val(.Value)
            Else
                arr(x) = .Value
            End If
            
        End With
    Next x
        
        CastMember = arr(3)
        
'check for duplicate payroll numbers
        If WorksheetFunction.CountIf(wsDatabase.Range("D:D"), arr(4)) > 0 Then
            MsgBox CastMember & Chr(10) & "This cast member already exists", 16, "Member Exists"
            Exit Sub
        End If
        
'set the next row in the database
        Set nextrow = wsDatabase.Cells(wsDatabase.Rows.Count, 1).End(xlUp).Offset(1, 0)
'add record to worksheet
        nextrow.Resize(, cNum).Value = arr
'SAP# number format
        nextrow.Offset(, 3).NumberFormat = "00000"
        
'clear the controls
        For x = 1 To cNum
            Me.Controls("Reg" & x).Value = ""
        Next
        
'inform user
        MsgBox CastMember & Chr(10) & "New Record Added", 64, "New Record"
        
'error block
        On Error GoTo 0
        
        Exit Sub
        
errHandler:
        ShowErrorMsg
End Sub


Private Sub cmdClose_Click()
    Unload Me
End Sub
Private Sub cmdData_Click()
    wsDatabase.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 wsDatabase.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
                    With lstlookup
                        .AddItem rngFind.Text
                        .List(lstlookup.ListCount - 1, 1) = rngFind.Offset(0, -1).Text
                        .List(lstlookup.ListCount - 1, 2) = rngFind.Offset(0, 1).Text
                        .List(lstlookup.ListCount - 1, 3) = rngFind.Offset(0, 2).Text
                        .List(lstlookup.ListCount - 1, 4) = rngFind.Offset(0, 4).Text
                        .List(lstlookup.ListCount - 1, 5) = rngFind.Offset(0, 5).Text
                        .List(lstlookup.ListCount - 1, 6) = rngFind.Offset(0, 6).Text
                        .List(lstlookup.ListCount - 1, 7) = rngFind.Offset(0, 7).Text
'record row
                        .List(lstlookup.ListCount - 1, 8) = rngFind.Row
                    End With
                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
    
    ButtonsEnable True
'error block
    On Error GoTo 0
    Exit Sub
    
errHandler:
    ShowErrorMsg
End Sub


Private Sub cmdReset_Click()
'clear the Reg controls
    
    For x = 1 To cNum
        Me.Controls("Reg" & x).Value = ""
    Next
'enable adding new staff
   ButtonsEnable True
   
'enable adding new payroll number
    Me.reg4.Enabled = True
'clear the listbox
    lstlookup.Clear
'clear the textbox
    Me.txtlookup.Value = ""
    CastMember = ""
End Sub


Private Sub lstLookup_Click()


    With Me.lstlookup
'get the records row no
        RowNo = Val(.Column(.ColumnCount, .ListIndex))
    End With
    
'add record to controls
    For x = 1 To cNum
        Me.Controls("Reg" & x).Value = wsDatabase.Cells(RowNo, x).Text
    Next
    
    CastMember = Me.reg3.Text
    
'disable adding
    ButtonsEnable False
End Sub


Private Sub cmdDelete_Click()
'declare the variables
    Dim cDelete As VbMsgBoxResult
    
    'error handling
    On Error GoTo errHandler
    
'give the user a chance to change their mind
    cDelete = MsgBox(CastMember & Chr(10) & _
                    "Are you sure that you want to delete this cast member?", 292, "Are you sure????")
    If cDelete = vbYes Then
    
        wsDatabase.Cells(RowNo, 1).EntireRow.Delete


'clear the controls
    For x = 1 To cNum
        Me.Controls("Reg" & x).Value = ""
    Next
'refresh the listbox
    Lookup
    
    MsgBox CastMember & Chr(10) & "Record Deleted", 64, "Record Deleted"
    
    End If
    
    Exit Sub
    
errHandler:
    ShowErrorMsg
End Sub


Private Sub cmdEdit_Click()
    Dim SelectionIndex As Integer
'error handling
    On Error GoTo errHandler
    
'check for values
    If reg1.Value = "" Or reg2.Value = "" Then
        MsgBox "There is no data to edit", 48, "Entry Required"
        Exit Sub
    Else
'if the edit is a name then add it
        Call Reg2_Change
    End If
    
'edit the row
    For x = 1 To cNum
        wsDatabase.Cells(RowNo, x).Value = Me.Controls("Reg" & x).Value
    Next


'mark selected record
    SelectionIndex = Me.lstlookup.ListIndex
'refresh the listbox
    Lookup
    
    Me.lstlookup.ListIndex = SelectionIndex
    
'error block
    On Error GoTo 0
'inform user
    MsgBox CastMember & Chr(10) & "Record Updated", 48, "Record Updated"
    Exit Sub
    
errHandler:
    ShowErrorMsg
End Sub


Private Sub Reg2_Change()
'get the full name
    Me.reg3.Value = Me.reg1.Value + ", " + Me.reg2.Value
End Sub


Sub ShowErrorMsg()
    MsgBox "An Error has Occurred  " & vbCrLf & _
    "The error number is:  " & Err.Number & vbCrLf & _
    Err.Description & vbCrLf & "Please notify the administrator"
    Err.Clear
End Sub


Sub ButtonsEnable(ByVal State As Boolean)
    Me.cmdadd.Enabled = State
    Me.cmdedit.Enabled = Not State
    Me.cmddelete.Enabled = Not State
End Sub


Private Sub UserForm_Initialize()
   Set wsDatabase = ThisWorkbook.Worksheets("Database")
   
'column 8 is a hidden place holder for selected record row
   With Me.lstlookup
    .ColumnCount = 8
    .ColumnWidths = "60 pt;110 pt;70 pt;49.95 pt;70 pt;70 pt;100 pt;0 pt"
    End With
    
    ButtonsEnable True
End Sub

You were repeating code in your procedures which should not be necessary
Updated code not fully tested but hopefully, will do what you want

Dave
 
Last edited:
Upvote 0
dmt32 said:
Hi,
Finally found moment to look at your code & made some changes

Make backup of your workbook & replace ALL code in your form with following:

Code: 
Option Explicit
'Module level variables
Const cNum As Integer = 13
Dim x As Integer
Dim CastMember As String
Dim wsDatabase As Worksheet
Dim RowNo As Long


Private Sub cmdAdd_Click()
    Dim nextrow As Range
    Dim arr() As Variant
    
'size array
    ReDim arr(1 To cNum)
    
'error handler
    On Error GoTo errHandler
    
'check for values in the first 4 controls
    For x = 1 To cNum
        With Me.Controls("Reg" & x)
            If x < 5 And .Value = "" Then
                .SetFocus
                MsgBox "You must add all data", 48, "Entry Required"
                Exit Sub
            End If
            
'get corret data type
'note IsDate & IsNumeric functions have limitations & may not always
'produce required result
            If IsDate(.Value) Then
                arr(x) = DateValue(.Value)
            ElseIf IsNumeric(.Value) Then
                arr(x) = Val(.Value)
            Else
                arr(x) = .Value
            End If
            
        End With
    Next x
        
        CastMember = arr(3)
        
'check for duplicate payroll numbers
        If WorksheetFunction.CountIf(wsDatabase.Range("D:D"), arr(4)) > 0 Then
            MsgBox CastMember & Chr(10) & "This cast member already exists", 16, "Member Exists"
            Exit Sub
        End If
        
'set the next row in the database
        Set nextrow = wsDatabase.Cells(wsDatabase.Rows.Count, 1).End(xlUp).Offset(1, 0)
'add record to worksheet
        nextrow.Resize(, cNum).Value = arr
'SAP# number format
        nextrow.Offset(, 3).NumberFormat = "00000"
        
'clear the controls
        For x = 1 To cNum
            Me.Controls("Reg" & x).Value = ""
        Next
        
'inform user
        MsgBox CastMember & Chr(10) & "New Record Added", 64, "New Record"
        
'error block
        On Error GoTo 0
        
        Exit Sub
        
errHandler:
        ShowErrorMsg
End Sub


Private Sub cmdClose_Click()
    Unload Me
End Sub
Private Sub cmdData_Click()
    wsDatabase.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 wsDatabase.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
                    With lstlookup
                        .AddItem rngFind.Text
                        .List(lstlookup.ListCount - 1, 1) = rngFind.Offset(0, -1).Text
                        .List(lstlookup.ListCount - 1, 2) = rngFind.Offset(0, 1).Text
                        .List(lstlookup.ListCount - 1, 3) = rngFind.Offset(0, 2).Text
                        .List(lstlookup.ListCount - 1, 4) = rngFind.Offset(0, 4).Text
                        .List(lstlookup.ListCount - 1, 5) = rngFind.Offset(0, 5).Text
                        .List(lstlookup.ListCount - 1, 6) = rngFind.Offset(0, 6).Text
                        .List(lstlookup.ListCount - 1, 7) = rngFind.Offset(0, 7).Text
'record row
                        .List(lstlookup.ListCount - 1, 8) = rngFind.Row
                    End With
                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
    
    ButtonsEnable True
'error block
    On Error GoTo 0
    Exit Sub
    
errHandler:
    ShowErrorMsg
End Sub


Private Sub cmdReset_Click()
'clear the Reg controls
    
    For x = 1 To cNum
        Me.Controls("Reg" & x).Value = ""
    Next
'enable adding new staff
   ButtonsEnable True
   
'enable adding new payroll number
    Me.reg4.Enabled = True
'clear the listbox
    lstlookup.Clear
'clear the textbox
    Me.txtlookup.Value = ""
    CastMember = ""
End Sub


Private Sub lstLookup_Click()


    With Me.lstlookup
'get the records row no
        RowNo = Val(.Column(.ColumnCount, .ListIndex))
    End With
    
'add record to controls
    For x = 1 To cNum
        Me.Controls("Reg" & x).Value = wsDatabase.Cells(RowNo, x).Text
    Next
    
    CastMember = Me.reg3.Text
    
'disable adding
    ButtonsEnable False
End Sub


Private Sub cmdDelete_Click()
'declare the variables
    Dim cDelete As VbMsgBoxResult
    
    'error handling
    On Error GoTo errHandler
    
'give the user a chance to change their mind
    cDelete = MsgBox(CastMember & Chr(10) & _
                    "Are you sure that you want to delete this cast member?", 292, "Are you sure????")
    If cDelete = vbYes Then
    
        wsDatabase.Cells(RowNo, 1).EntireRow.Delete


'clear the controls
    For x = 1 To cNum
        Me.Controls("Reg" & x).Value = ""
    Next
'refresh the listbox
    Lookup
    
    MsgBox CastMember & Chr(10) & "Record Deleted", 64, "Record Deleted"
    
    End If
    
    Exit Sub
    
errHandler:
    ShowErrorMsg
End Sub


Private Sub cmdEdit_Click()
    Dim SelectionIndex As Integer
'error handling
    On Error GoTo errHandler
    
'check for values
    If reg1.Value = "" Or reg2.Value = "" Then
        MsgBox "There is no data to edit", 48, "Entry Required"
        Exit Sub
    Else
'if the edit is a name then add it
        Call Reg2_Change
    End If
    
'edit the row
    For x = 1 To cNum
        wsDatabase.Cells(RowNo, x).Value = Me.Controls("Reg" & x).Value
    Next


'mark selected record
    SelectionIndex = Me.lstlookup.ListIndex
'refresh the listbox
    Lookup
    
    Me.lstlookup.ListIndex = SelectionIndex
    
'error block
    On Error GoTo 0
'inform user
    MsgBox CastMember & Chr(10) & "Record Updated", 48, "Record Updated"
    Exit Sub
    
errHandler:
    ShowErrorMsg
End Sub


Private Sub Reg2_Change()
'get the full name
    Me.reg3.Value = Me.reg1.Value + ", " + Me.reg2.Value
End Sub


Sub ShowErrorMsg()
    MsgBox "An Error has Occurred  " & vbCrLf & _
    "The error number is:  " & Err.Number & vbCrLf & _
    Err.Description & vbCrLf & "Please notify the administrator"
    Err.Clear
End Sub


Sub ButtonsEnable(ByVal State As Boolean)
    Me.cmdadd.Enabled = State
    Me.cmdedit.Enabled = Not State
    Me.cmddelete.Enabled = Not State
End Sub


Private Sub UserForm_Initialize()
   Set wsDatabase = ThisWorkbook.Worksheets("Database")
   
'column 8 is a hidden place holder for selected record row
   With Me.lstlookup
    .ColumnCount = 8
    .ColumnWidths = "60 pt;110 pt;70 pt;49.95 pt;70 pt;70 pt;100 pt;0 pt"
    End With
    
    ButtonsEnable True
End Sub

You were repeating code in your procedures which should not be necessary
Updated code not fully tested but hopefully, will do what you want

Dave
Click to expand...

IMPECCABLE DAVE.
it was fanatics now:rofl:

THANKS A LOT
 
Last edited:
Upvote 0
kelvin_9 said:
IMPECCABLE DAVE.
it was fanatics now:rofl:

THANKS A LOT
Click to expand...

Hi,
glad it worked ok but I posted an early development copy

Following has a common procedure to Add or update record.

Code: 
Option Explicit
'Module level variables
Const cNum As Integer = 13
Dim x As Integer
Dim CastMember As String
Dim wsDatabase As Worksheet
Dim RowNo As Long


'********************************************************************************************************************
'***********************************************COMMAND BUTTONS******************************************************
Private Sub cmdAdd_Click()
    AddRecord True
End Sub
Private Sub cmdEdit_Click()
    AddRecord False
End Sub
Private Sub cmdClose_Click()
    Unload Me
End Sub
Private Sub cmdData_Click()
    wsDatabase.Select
End Sub
Private Sub cmdLookup_Click()
    Lookup
End Sub
Private Sub cmdReset_Click()
    ResetForm
End Sub


Private Sub cmdDelete_Click()
'declare the variables
    Dim cDelete As VbMsgBoxResult
    Dim MemberName As String
    
    MemberName = CastMember
    
'error handling
    On Error GoTo errHandler
    
'give the user a chance to change their mind
    cDelete = MsgBox(MemberName & Chr(10) & _
    "Are you sure that you want to delete this cast member?", 292, "Are you sure????")
    If cDelete = vbYes Then
        
        wsDatabase.Cells(RowNo, 1).EntireRow.Delete
    
'refresh the listbox
        Lookup Me.lstlookup.ListIndex - 1
        
        MsgBox MemberName & Chr(10) & "Record Deleted", 64, "Record Deleted"


    End If
    
    Exit Sub
    
errHandler:
    ShowErrorMsg
End Sub


'*********************************************************************************************************************
'**************************************************LISTBOX CODE*******************************************************
Private Sub lstLookup_Click()


    With Me.lstlookup
'get the records row no
        RowNo = Val(.Column(.ColumnCount, .ListIndex))
    End With
    
'add record to controls
    For x = 1 To cNum
        Me.Controls("Reg" & x).Value = wsDatabase.Cells(RowNo, x).Text
    Next
    
    CastMember = Me.reg3.Text


End Sub
Sub Lookup(Optional ByVal SelectionIndex As Integer)
'declare the variables
    Dim rngFind As Range
    Dim strFirstFind As String
    
    If Len(txtlookup.Text) = 0 Then Exit Sub
'error statement
    On Error GoTo errHandler
'clear the listbox
    lstlookup.Clear
'look up parts or all of full mname
    With wsDatabase.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
                    With lstlookup
                        .AddItem rngFind.Text
                        .List(lstlookup.ListCount - 1, 1) = rngFind.Offset(0, -1).Text
                        .List(lstlookup.ListCount - 1, 2) = rngFind.Offset(0, 1).Text
                        .List(lstlookup.ListCount - 1, 3) = rngFind.Offset(0, 2).Text
                        .List(lstlookup.ListCount - 1, 4) = rngFind.Offset(0, 4).Text
                        .List(lstlookup.ListCount - 1, 5) = rngFind.Offset(0, 5).Text
                        .List(lstlookup.ListCount - 1, 6) = rngFind.Offset(0, 6).Text
                        .List(lstlookup.ListCount - 1, 7) = rngFind.Offset(0, 7).Text
'record row
                        .List(lstlookup.ListCount - 1, 8) = rngFind.Row
                    End With
                End If
'find the next address
                Set rngFind = .FindNext(rngFind)
                If rngFind Is Nothing Then Exit Do
            Loop While rngFind.Address <> strFirstFind
            
            Me.lstlookup.ListIndex = SelectionIndex
            Call lstLookup_Click
            
'disable adding
            ButtonsEnable False
        Else
        
'payroll editing
     Me.reg4.Enabled = True
'enable adding
     ButtonsEnable True
            
        End If
    End With
    
'error block
    On Error GoTo 0
    Exit Sub
    
errHandler:
    ShowErrorMsg
End Sub


'**********************************************************************************************************************
'*************************************************ADD RECORD CODE******************************************************
Sub AddRecord(Optional ByVal NewRecord As Boolean)
    Dim arr() As Variant
    Dim RecordRow As Range
    Dim SelectionIndex As Integer
    
'size array
    ReDim arr(1 To cNum)
    
'error handler
    On Error GoTo errHandler
    
'check for values in the first 4 controls
    For x = 1 To cNum
        With Me.Controls("Reg" & x)
            If x < 5 And .Value = "" Then
                .SetFocus
                MsgBox "You must add all data", 48, "Entry Required"
                Exit Sub
            End If
            
'get corret data type
'note IsDate & IsNumeric functions have limitations & may not always
'produce required result
            If IsDate(.Value) Then
                arr(x) = DateValue(.Value)
            ElseIf IsNumeric(.Value) Then
                arr(x) = Val(.Value)
            Else
                arr(x) = .Value
            End If
            
        End With
        Next x
        
'set the row in the database
        If NewRecord Then
        
        CastMember = arr(3)
        
'check for duplicate payroll numbers
            If WorksheetFunction.CountIf(wsDatabase.Range("D:D"), arr(4)) > 0 Then
                MsgBox CastMember & Chr(10) & "This cast member already exists", 16, "Member Exists"
                Exit Sub
            Else
'new record - get next row
                Set RecordRow = wsDatabase.Cells(wsDatabase.Rows.Count, 1).End(xlUp).Offset(1, 0)
            End If
        Else
'update record - get record row
            Set RecordRow = wsDatabase.Cells(RowNo, 1)
        End If
'add record to worksheet
        RecordRow.Resize(, cNum).Value = arr
        
        If Not NewRecord Then


'refresh the listbox
            Lookup Me.lstlookup.ListIndex
             
'inform user
            MsgBox CastMember & Chr(10) & "Record Updated", 64, "Record Updated"
            
        Else
            
'inform user
            MsgBox CastMember & Chr(10) & "New Record Added", 64, "New Record"
            
'clear the controls
            ResetForm
            
        End If
    
errHandler:
        If Err <> 0 Then ShowErrorMsg
End Sub
'*********************************************************************************************************************


Private Sub Reg2_Change()
'get the full name
    Me.reg3.Value = Me.reg1.Value + ", " + Me.reg2.Value
End Sub


Sub ResetForm()


'clear the Reg controls
    For x = 1 To cNum
        Me.Controls("Reg" & x).Value = ""
    Next
'enable adding
   ButtonsEnable True
   
'enable adding new payroll number
    Me.reg4.Enabled = True
'clear the listbox
    lstlookup.Clear
'clear the textbox
    Me.txtlookup.Value = ""
    CastMember = ""
End Sub


Sub ShowErrorMsg()
    MsgBox "An Error has Occurred  " & vbCrLf & _
    "The error number is:  " & Err.Number & vbCrLf & _
    Err.Description & vbCrLf & "Please notify the administrator"
    Err.Clear
End Sub


Sub ButtonsEnable(ByVal State As Boolean)
    Me.cmdadd.Enabled = State
    Me.cmdedit.Enabled = Not State
    Me.cmddelete.Enabled = Not State
End Sub


Private Sub UserForm_Initialize()
   Set wsDatabase = ThisWorkbook.Worksheets("Database")
   
'column 8 is a hidden place holder for selected record row
   With Me.lstlookup
    .ColumnCount = 8
    .ColumnWidths = "60 pt;110 pt;70 pt;49.95 pt;70 pt;70 pt;100 pt;0 pt"
    End With
    
    ButtonsEnable True
End Sub


Make backup before testing new code

Dave
 
Upvote 0
You must log in or register to reply here.

Similar threads

Z
  • Solved
Code working within a file, giving Error 448 within another file
Replies
2
Views
137
zankzank
Z
KlausW
  • Solved
Take fil name from cell
Replies
4
Views
251
KlausW
KlausW
sparky2205
  • Question Question
ListBox not highlighting selection
Replies
0
Views
499
sparky2205
sparky2205
R
  • Solved
Error 1004 - Delete method of range class failed
3 4 5
Replies
42
Views
3K
MARK858
MARK858
M
  • Question Question
Re-produce code to copy last row from listbox on userform to sheet
Replies
3
Views
166
MKLAQ
M

Forum statistics

Threads
1,224,823
Messages
6,181,180
Members
453,021
Latest member
Justyna P

Share this page

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
Back
Top