Excel VBA + Userforms

IThelp

New Member
Joined
Jan 2, 2017
Messages
32
For my A-Level Coursework I have to design a fully functioning till system which contains staff data and payslips etc. I have designed a userform which enables you to add a new member. within this userform is a lookup box which brings up the persons name when you type their name in. I am trying to get all the data about the person to go into the text boxes on the userform when you double click on the person so their details can be etited. Also i wish for a new row to be created and the new staff data to be entered into that row when you click the add button. Any help with this would be extremely grateful.
many thanks
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Thank you @awatt for replying,
the data that I am trying to bring up is stored in the same spreadsheet where I have created the userform
 
Upvote 0
Thank you awatt for replying,
the data that I am trying to bring up is stored in the same spreadsheet where I have created the userform
 
Upvote 0
I'm not sure if this helps or not but I have tables setup for my data each column is the answer to one of the data questions IE Column A = Name Column B = Address .... Then for each column I have named the range IE Column A = lstNAME Column B = lstADD etc.

For the name changing I used a combobox. You can do the same if yours is a command button but instaed of the change section you would do this in the click section. In VBA I wrote the following code:

This code would go into the change section of the form where you're changing the name.
Code:
ComboBox.RowSource = "lstNAME"

Then for the command button you would input this into the click section or the change section for a ComboBox, for each TextBox I wrote the following code:

Code:
textbox2 = Worksheets("Sheet1").Range("lstADD").Cells(ComboBox.ListIndex + 1, 1).Text 
TextBox3 = Worksheets("Sheet1").Range("lstAGE").Cells(ComboBox.ListIndex + 1, 1).text

And so on...

Of course you need to change the names of the worksheets, ranges, and names of the tools.

For the add function I assume you're using a command button to add so I would do this

Code:
Dim c as range
  With Cells
      If c Is Nothing Then
         Set c = .Find(ComboBox.Value, LookIn:=xlValues)
   Else
      Set c = .FindNext(c)
   End If
      If Not c is Nothing Then c.Select
   End With

'For this section you need to match the columns with the correct TextBox

c.Offset(0,1).Value = TextBox2
c.Offset(0,2).Value = TextBox3

And so on...

I hope this helps.
 
Upvote 0
Thank you for taking the time to respond.
Below is the all the codes I have used which some may not be correct.
Code:
Option Explicit
'Private variables
Dim cNum As Integer
Dim X As Integer
Private Sub cmdadd_Click()

lrow = Selection.Row()
Rows(lrow).Select
Selection.Copy
Rows(lrow + 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Selection.ClearContents

 Dim LastRow As Long
LastRow = Sheet8.Cells(Sheet8.Rows.Count, "A").End(xlUp + 1).Row

Sheet8.Range("G" + "LastRow").Value = reg1.Text
Sheet8.Range("H" + "LastRow").Value = reg2.Text
Sheet8.Range("I" + "LastRow").Value = reg3.Text
Sheet8.Range("J" + "LastRow").Value = reg4.Text
Sheet8.Range("K" + "LastRow").Value = reg5.Text
Sheet8.Range("L" + "LastRow").Value = reg6.Text

End Sub

Private Sub cmdclose_Click()
Unload Me
End Sub

Private Sub cmdData_Click()
    Sheet8.Select
    Unload Me
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 not 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 staff member", vbYesNo + vbDefaultButton2, "Are you sure????")
    If cDelete = vbYes Then
        'delete the row
        Set findvalue = Sheet8.Range("G:G").Find(What:=reg2, 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
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 Sheet8.Range("G:G")
        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, 2)
                    lstlookup.List(lstlookup.ListCount - 1, 3) = rngFind.Offset(0, 3)
                    lstlookup.List(lstlookup.ListCount - 1, 4) = rngFind.Offset(0, 4)
                    lstlookup.List(lstlookup.ListCount - 1, 5) = rngFind.Offset(0, 5)
                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.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 cmdLookup_Click()
    Lookup
End Sub

Private Sub lstLookup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'declare the variables
    Dim cFullName As String
    Dim I As String
    Dim findvalue
    'error block
      On Error GoTo errHandler:
    'get the select value from the listbox
    For I = "" To lstlookup.ListCount - 1
        If lstlookup.Selected(I) = True Then
            cPayroll = lstlookup.List(I, 1)
        End If
    Next I
    'find the payroll number
    'find the payroll number
    Set findvalue = Sheet8.Range("G:G").Find(What:=cFullName, LookIn:=xlValues).Offset(0, 5)
    'add the database values to the userform
    cNum = 6
    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

[CODE]
[/CODE]

on my userform is listboxes. One is to search for existing staff members and the others shows the results. I am using a lookup for this. My aim is to double click the lookup result so that those details are then put onto the other listboxes which then allows their details to be changed and therefore saved once you click the edit command button.
Another problem which I am trying to address is the add button. This should add a new row below the last person and then save the details of the new staff into that row. It would be really helpful if you could help me with this.

Again Many Thanks!
 
Upvote 0
Thank you for taking the time to respond.
Below is the all the codes I have used which some may not be correct.
Code:
Option Explicit
'Private variables
Dim cNum As Integer
Dim X As Integer
Private Sub cmdadd_Click()

lrow = Selection.Row()
Rows(lrow).Select
Selection.Copy
Rows(lrow + 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Selection.ClearContents

 Dim LastRow As Long
LastRow = Sheet8.Cells(Sheet8.Rows.Count, "A").End(xlUp + 1).Row

Sheet8.Range("G" + "LastRow").Value = reg1.Text
Sheet8.Range("H" + "LastRow").Value = reg2.Text
Sheet8.Range("I" + "LastRow").Value = reg3.Text
Sheet8.Range("J" + "LastRow").Value = reg4.Text
Sheet8.Range("K" + "LastRow").Value = reg5.Text
Sheet8.Range("L" + "LastRow").Value = reg6.Text

End Sub

Private Sub cmdclose_Click()
Unload Me
End Sub

Private Sub cmdData_Click()
    Sheet8.Select
    Unload Me
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 not 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 staff member", vbYesNo + vbDefaultButton2, "Are you sure????")
    If cDelete = vbYes Then
        'delete the row
        Set findvalue = Sheet8.Range("G:G").Find(What:=reg2, 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
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 Sheet8.Range("G:G")
        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, 2)
                    lstlookup.List(lstlookup.ListCount - 1, 3) = rngFind.Offset(0, 3)
                    lstlookup.List(lstlookup.ListCount - 1, 4) = rngFind.Offset(0, 4)
                    lstlookup.List(lstlookup.ListCount - 1, 5) = rngFind.Offset(0, 5)
                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.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 cmdLookup_Click()
    Lookup
End Sub

Private Sub lstLookup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'declare the variables
    Dim cFullName As String
    Dim I As String
    Dim findvalue
    'error block
      On Error GoTo errHandler:
    'get the select value from the listbox
    For I = "" To lstlookup.ListCount - 1
        If lstlookup.Selected(I) = True Then
            cPayroll = lstlookup.List(I, 1)
        End If
    Next I
    'find the payroll number
    'find the payroll number
    Set findvalue = Sheet8.Range("G:G").Find(What:=cFullName, LookIn:=xlValues).Offset(0, 5)
    'add the database values to the userform
    cNum = 6
    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

on my userform is listboxes. One is to search for existing staff members and the others shows the results. I am using a lookup for this. My aim is to double click the lookup result so that those details are then put onto the other listboxes which then allows their details to be changed and therefore saved once you click the edit command button.
Another problem which I am trying to address is the add button. This should add a new row below the last person and then save the details of the new staff into that row. It would be really helpful if you could help me with this.

Again Many Thanks!

It would be easier if I had your actual workbook but here is my solution for your Add button.

I found two issues with the way you had your code. First issue was that in the range section of your code you had LastRow in quotations. The Second issue was that you used the plus symbol (+) but you should have used the ampersand symbol (&). I didn't see the need for all of the other code you had at the top with the declarations so I removed them, but you can add it back if you need it.

Here is the code I came up with.

Code:
Private Sub cmdadd_Click()

Dim ws As Worksheet
Dim LastRow As Long

Set ws = Sheet8

If Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
    LastRow = 2
Else
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
        
With ws
    Range("G" & LastRow).Value = reg1.Value
    Range("H" & LastRow).Value = reg2.Value
    Range("I" & LastRow).Value = reg3.Value
    Range("J" & LastRow).Value = reg4.Value
    Range("K" & LastRow).Value = reg5.Value
    Range("L" & LastRow).Value = reg6.Value
End With

End Sub

I'll try to work out your other issue but that will take me sometime.
 
Last edited:
Upvote 0
awatt, Thank you once again for your help it is much appreciated.
Using the code you have given, the data goes into row 2 which is not where i intended for it to go and is far off the other data. Is it possible for a code to add a new row below the selected cell and then put in the data into that new row to the asigned columns?

Once again Thank you for your help!
 
Upvote 0
Hmm...

It should be looking at column A for the last row try removing the If statement and just have the LastRow statement

Code:
LastRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
If you don't want it to look in the first column is there a specific column you want VBA to look for the next open row?

I have a very crude setup to work this out. I have info in A1:A8 when I run the userform it put the info for reg1 into G9. Is that not what you wanted to happen?

Let me know.
 
Upvote 0
I have data from G11:L37. the VBA code should put data from reg1 into G38 but instead puts it into G2. Another thing is that i have a border going around so i would need new rows added below from G37 so that everthing remains within the border. Hence why I need the code to insert a new row below the last row which should be row 37. The code successfully put the infromation from each reg to the correct columns but not into the correct row.
 
Upvote 0

Forum statistics

Threads
1,223,920
Messages
6,175,377
Members
452,638
Latest member
Oluwabukunmi

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