Userform for Data Entry Into Several Different Worksheets

T

TheJay

Active Member
Joined
Nov 12, 2014
Messages
364
Office Version
  1. 2019
Platform
  1. Windows
I am creating a userform to search and manage a list of contacts.

There is currently no search facility whilst I work on getting the data input/edit capability running as it should.
PhwEWSy.png

ZhnyjMN.png


The first function I am trying to implement is decribed below.

The master linked accounts section is hidden unless the corresponding worksheets are selected where this information is applicable. When one of the worksheets that this information is relevant to is selected in the combobox, it should populate MLA option buttons.

I have two option buttons to the form 'MLA' called 'mstrYes' and 'mstrNo'. 'mstrNo' should be the default and I want to prevent the text box 'txt7' from appearing until mstrYes is selected, and if mstrNo is selected again, the text box should disappear again.

Also in relation to the text box 'txt7', how do I prevent the text within 'txt7' that appears automatically in 'Example1, Example2, Example3' mentioned previously from being cleared during the following procedure?

Code: 
Dim ws As Worksheet

Private Sub cbContactType_Change()
    Me.cmdbNew.Enabled = CBool(Me.cbContactType.ListIndex <> -1)
    If Me.cbContactType.Enabled Then Set ws = Worksheets(cbContactType.Text)
    Me.txt7.Visible = Not IsError(Application.Match(cbContactType.Text, Array("Housing Associations", "Landlords"), False))
    Me.mstrAccounts.Visible = Me.txt7.Visible
    Me.MLA.Visible = Me.txt7.Visible
End Sub




Private Sub iptSearch_Click()
      Contacts.Hide
      Unload Contacts
End Sub




'Private Sub cmdbChange_SpinUp()
'    If Me.cbContactType.ListRows.Count < 1 Then Exit Sub
'    If CurrentRow > 1 Then
'        CurrentRow = CurrentRow - 1
'        UpdatecmdbChange
'    End If
'End Sub




'Private Sub cmdbChange_SpinDown()
'    If CurrentRow = Me.cbContactType.ListRows.Count Then Exit Sub
'    If CurrentRow < Me.cbContactType.ListRows.Count Then
'        CurrentRow = CurrentRow + 1
'        UpdatecmdbChange
'    End If
'End Sub




'Private Sub UpdatePositionCaption()
'    dtaRow.Caption = CurrentRow & " of " & Me.cbContactType.ListRows.Count
'End Sub




Private Sub UserForm_Initialize()
    Me.cbContactType.List = Array("Council Contacts", "Local Contacts", "Housing Associations", "Landlords", "Letting and Selling Agents", "Developers", "Employers")
    Me.cmdbNew.Enabled = False
    Me.txt7.Visible = False
    Me.mstrAccounts.Visible = False
    Me.MLA.Visible = False
End Sub




Private Sub cmdbNew_Click()
Dim cNum As Integer, X As Integer
    Dim nextrow As Long
    nextrow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    If Len(ws.Cells(1, 2).Value) > 0 Then nextrow = nextrow + 1
    cNum = 7
    Dim AlignLeft As Boolean
    For X = 1 To cNum
    AlingLeft = CBool(X = 1 Or X = 7)
    With ws.Cells(nextrow, X + 1)
        .Value = Me.Controls("txt" & X).Value
        .EntireColumn.AutoFit
        .HorizontalAlignment = IIf(X = 1, xlLeft, xlCenter)
        .VerticalAlignment = xlCenter
        With .Font
             .Name = "Arial"
             .FontStyle = "Regular"
             .Size = 10
        End With
    End With
    Me.Controls("txt" & X).Text = ""
    Next
    MsgBox "Contact added to " & ws.Name, 64, "Contact Added"
End Sub




Private Sub cmdbClose_Click()
Unload Me
End Sub
 
Sort by date Sort by votes

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
It would be a good idea to grey out the update button until the spinbuttons are used to make sure a valid row is selected before editing as well.
 
Upvote 0
I have updated the workbook to include a listbox called 'lb'.
 
Upvote 0
Here's the new code (complete) which includes the listbox (the one that was already on the form. Change the name if you want to have a new one).

Code: 
Option Explicit
Dim objCtrl As Control
Dim cNum As Integer, X As Integer, i As Integer
Dim nextrow As Long
Dim AlignLeft As Boolean
Private Sub UserForm_Initialize()
    cbContactType.List = Array("Council Contacts", "Local Contacts", "Housing Associations", "Landlords", "Letting and Selling Agents", "Developers", "Employers")
    cmdbNew.Enabled = False
    txt7.Visible = False
    mstrAccounts.Visible = False
    MLA.Visible = False
    mstrNo.Value = True
    cmdbChange.Enabled = False
    lstbData.ColumnCount = 6
    lstbData.ColumnHeads = True
        
        For Each objCtrl In Me.Controls
            If Left(objCtrl.Name, 4) = "Text" Then txt7.Visible = False
        Next
        If txt7.Value = "" Then
            txt7.Value = "Example1: " & vbCrLf & "Example2: " & vbCrLf & "Example3: "
        End If
End Sub
Private Sub cbContactType_Change()
    cmdbNew.Enabled = CBool(cbContactType.ListIndex <> -1)
    mstrNo.Value = True
    If cbContactType.Enabled Then Set ws = Worksheets(cbContactType.Text)
    
    If cbContactType.Value = "Housing Associations" Or _
       cbContactType.Value = "Landlords" Then
       mstrAccounts.Visible = True
       MLA.Visible = True
    Else
        mstrAccounts.Visible = False
        MLA.Visible = False
    End If
    
    lastRow = ws.Range("B" & Rows.Count).End(xlUp).Row
    If ws.Name = "Developers" Or ws.Name = "Employers" Then lastRow = lastRow - 1
    CurrentRow = lastRow + 1
    
    'loop thru and clear textboxes
    For i = 1 To 6
        Contacts.Controls("txt" & i).Value = ""
    Next i
    
    Contacts.dtaRow.Caption = lastRow - 1 & " Record(s)"
    
    cmdbChange.Enabled = True
    ws.Activate
    lstbData.RowSource = "B2:G" & lastRow
End Sub
Private Sub lstbData_Click()
    CurrentRow = lstbData.ListIndex + 2
    UpdatecmdbChange
End Sub
Private Sub cmdbChange_SpinDown()
    If CurrentRow > 2 Then
        CurrentRow = CurrentRow - 1
        UpdatecmdbChange
    Else
        CurrentRow = lastRow
        UpdatecmdbChange
    End If
    lstbData.ListIndex = CurrentRow - 2
End Sub
Private Sub cmdbChange_SpinUp()
    If CurrentRow < lastRow Then
        CurrentRow = CurrentRow + 1
        UpdatecmdbChange
    Else
        CurrentRow = 2
        UpdatecmdbChange
    End If
    lstbData.ListIndex = CurrentRow - 2
End Sub
Private Sub iptSearch_Click()
    Contacts.Hide
    Unload Contacts
End Sub
Private Sub cmdbUpdate_Click()
    'yet to be completed
End Sub
Private Sub mstrYes_Click()
    txt7.Visible = True
End Sub
Private Sub mstrNo_Click()
    txt7.Visible = False
End Sub
Private Sub cmdbDelete_Click()
Dim smessage As String
    smessage = "Are you sure you want to delete this contact?" & vbCrLf & vbCrLf & "Name: " & txt2.Text & vbCrLf & "From: " & txt1.Text
    
    If MsgBox(smessage, vbQuestion & vbYesNo, _
              "Confirm Delete") = vbYes Then
    ws.Rows(CurrentRow).Delete
    End If
    lastRow = lastRow - 1
    lstbData.RowSource = "B2:G" & lastRow
End Sub
Private Sub cmdbNew_Click()
    If txt1.Value = "" And txt2.Value = "" And txt3.Value = "" _
        And txt4.Value = "" And txt5.Value = "" And txt6.Value = "" Then
        MsgBox "Please enter data into at least one field.", 64, "Error"
        Exit Sub
    End If
    nextrow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    If Len(ws.Cells(1, 2).Value) > 0 Then nextrow = nextrow + 1
        If txt7.Visible = True Then
            cNum = 7
        Else
            cNum = 6
        End If
    For X = 1 To cNum
        AlignLeft = CBool(X = 1 Or X = 7)
        With ws.Cells(nextrow, X + 1)
            .Value = Me.Controls("txt" & X).Value
            .EntireColumn.AutoFit
            .HorizontalAlignment = IIf(X = 1 Or X = 7, xlLeft, xlCenter)
            .VerticalAlignment = xlCenter
                With .Font
                     .Name = "Arial"
                     .FontStyle = "Regular"
                     .Size = 10
                End With
        End With
        Controls("txt" & X).Text = ""
    Next
    MsgBox "Contact added to " & ws.Name, 64, "Success"
    Application.ScreenUpdating = False
    Unload Me
    Contacts.Show
    Application.ScreenUpdating = True
End Sub
Private Sub cmdbClose_Click()
Unload Me
End Sub
 
Upvote 0
Sheepdisease said:
It would be a good idea to grey out the update button until the spinbuttons are used to make sure a valid row is selected before editing as well.
Click to expand...

You can do this! Look at the code in the userform initialize event for how I set the spinbutton.enabled property to false. Do the same for the update button. Then reverse the process when either the spinbutton or the listbox are clicked. Let me know if you get stuck.

Regards,

CJ
 
Upvote 0
Thank you for your reply, now testing the listbox. At the moment I have included all worksheet names in the exception workaround for tables. Then on to the second implementation as per your recommendation.

Code: 
Option ExplicitDim objCtrl As Control
Dim cNum As Integer, X As Integer, i As Integer
Dim nextrow As Long
Dim AlignLeft As Boolean
Private Sub UserForm_Initialize()
    cbContactType.List = Array("Council Contacts", "Local Contacts", "Housing Associations", "Landlords", "Letting and Selling Agents", "Developers", "Employers")
    cmdbNew.Enabled = False
    txt7.Visible = False
    mstrAccounts.Visible = False
    MLA.Visible = False
    mstrNo.Value = True
    cmdbChange.Enabled = False
    lb.ColumnCount = 6
    lb.ColumnHeads = True
        
        For Each objCtrl In Me.Controls
            If Left(objCtrl.Name, 4) = "Text" Then txt7.Visible = False
        Next
        If txt7.Value = "" Then
            txt7.Value = "Example1: " & vbCrLf & "Example2: " & vbCrLf & "Example3: "
        End If
End Sub
Private Sub cbContactType_Change()
    cmdbNew.Enabled = CBool(cbContactType.ListIndex <> -1)
    mstrNo.Value = True
    If cbContactType.Enabled Then Set ws = Worksheets(cbContactType.Text)
    
    If cbContactType.Value = "Housing Associations" Or _
       cbContactType.Value = "Landlords" Then
       mstrAccounts.Visible = True
       MLA.Visible = True
    Else
        mstrAccounts.Visible = False
        MLA.Visible = False
    End If
    
    lastRow = ws.Range("B" & Rows.Count).End(xlUp).Row
    If ws.Name = "Council Contacts" Or ws.Name = "Local Contacts" Or ws.Name = "Housing Associations" Or ws.Name = "Landlords" Or ws.Name = "Letting and Selling Agents" Or ws.Name = "Developers" Or ws.Name = "Employers" Then lastRow = lastRow - 1
    CurrentRow = lastRow + 1
    
    'loop thru and clear textboxes
    For i = 1 To 6
        Contacts.Controls("txt" & i).Value = ""
    Next i
    
    Contacts.dtaRow.Caption = lastRow - 1 & " Record"
    
    cmdbChange.Enabled = True
    ws.Activate
    lb.RowSource = "B2:G" & lastRow
End Sub
Private Sub lb_Click()
    CurrentRow = lb.ListIndex + 2
    UpdatecmdbChange
End Sub
Private Sub cmdbChange_SpinDown()
    If CurrentRow > 2 Then
        CurrentRow = CurrentRow - 1
        UpdatecmdbChange
    Else
        CurrentRow = lastRow
        UpdatecmdbChange
    End If
    lb.ListIndex = CurrentRow - 2
End Sub
Private Sub cmdbChange_SpinUp()
    If CurrentRow < lastRow Then
        CurrentRow = CurrentRow + 1
        UpdatecmdbChange
    Else
        CurrentRow = 2
        UpdatecmdbChange
    End If
    lb.ListIndex = CurrentRow - 2
End Sub
Private Sub iptSearch_Click()
    Contacts.Hide
    Unload Contacts
End Sub
Private Sub cmdbUpdate_Click()
    'yet to be completed
End Sub
Private Sub mstrYes_Click()
    txt7.Visible = True
End Sub
Private Sub mstrNo_Click()
    txt7.Visible = False
End Sub
Private Sub cmdbDelete_Click()
Dim smessage As String
    smessage = "Are you sure you want to delete this contact?" & vbCrLf & vbCrLf & "Name: " & txt2.Text & vbCrLf & "From: " & txt1.Text
    
    If MsgBox(smessage, vbQuestion & vbYesNo, _
              "Delete") = vbYes Then
    ws.Rows(CurrentRow).Delete
    End If
    lastRow = lastRow - 1
    lb.RowSource = "B2:G" & lastRow
End Sub
Private Sub cmdbNew_Click()
    If txt1.Value = "" And txt2.Value = "" And txt3.Value = "" _
        And txt4.Value = "" And txt5.Value = "" And txt6.Value = "" Then
        MsgBox "Please enter data into at least one field.", 48, "Error"
        Exit Sub
    End If
    nextrow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    If Len(ws.Cells(1, 2).Value) > 0 Then nextrow = nextrow + 1
        If txt7.Visible = True Then
            cNum = 7
        Else
            cNum = 6
        End If
    For X = 1 To cNum
        AlignLeft = CBool(X = 1 Or X = 7)
        With ws.Cells(nextrow, X + 1)
            .Value = Me.Controls("txt" & X).Value
            .EntireColumn.AutoFit
            .HorizontalAlignment = IIf(X = 1 Or X = 7, xlLeft, xlCenter)
            .VerticalAlignment = xlCenter
                With .Font
                     .Name = "Arial"
                     .FontStyle = "Regular"
                     .Size = 10
                End With
        End With
        Controls("txt" & X).Text = ""
    Next
    MsgBox "Contact added to " & ws.Name, 64, "Success"
    Application.ScreenUpdating = False
    Unload Me
    Contacts.Show
    Application.ScreenUpdating = True
End Sub
Private Sub cmdbClose_Click()
Unload Me
End Sub
 
Upvote 0
I have updated the workbook in dropbox.

Can you please tell me how the width of the column headers is defined?
 
Upvote 0
There are two ways to set the column widths of a listbox:

1) Click on the listbox in the VBE and find the ColumnWidths property in the properties list (if this isn't showing press F4 or find it in the View menu). For that property, type in your column widths separated by semicolons. For example, 25 pt;125 pt;135 pt;67.95 pt.

2) In your userform.initialize event code add the following: Listbox1.ColumnWidths = "25 pt;125 pt;135 pt;67.95 pt".

I believe you can set the width sizes in pt, cm, or in. Or leave the units blank and excel will default them to pts.

Regards,

CJ
 
Upvote 0
Sheepdisease said:
At the moment I have included all worksheet names in the exception workaround for tables.
Click to expand...

So you reformatted all of the worksheets as tables? If that's the case then you really don't need that long 'If' statement. Simply just use:


Code: 
lastRow = ws.Range("B" & Rows.Count).End(xlUp).Row[COLOR=#ff0000] - 1[/COLOR]

CJ
 
Upvote 0
Thank you for your reply. Strangely it seems to work better without any code referencing the tables.

I have noticed that the listbox does not show the 'master account' header which is on several of the worksheets. Even if I change ColumnCount = 6 to ColumnCount = 7 or ColumnCount = 8 it makes no difference.

The dual functionality works well, clicking on an item in the listbox shows the data on the form. However, if there is a master account it should change the Master Account 'No' to 'Yes' and show the information in txt7. Moving to a different row with data in it should change it back to 'No'.

I have incorporated the behaviour you suggested by reproducing the code used for 'New' enable/disable.

Code: 
Option ExplicitDim objCtrl As Control
Dim cNum As Integer, X As Integer, i As Integer
Dim nextrow As Long
Dim AlignLeft As Boolean
Private Sub UserForm_Initialize()
    cbContactType.List = Array("Council Contacts", "Local Contacts", "Housing Associations", "Landlords", "Letting and Selling Agents", "Developers", "Employers")
    cmdbNew.Enabled = False
    cmdbUpdate.Enabled = False
    cmdbChange.Enabled = False
    txt7.Visible = False
    mstrAccounts.Visible = False
    MLA.Visible = False
    mstrNo.Value = True
    lb.ColumnCount = 6
    lb.ColumnHeads = True
    lb.ColumnWidths = "135 pt;135 pt;135 pt;135 pt;135 pt;135 pt;135 pt"
        
        For Each objCtrl In Me.Controls
            If Left(objCtrl.Name, 4) = "Text" Then txt7.Visible = False
        Next
        If txt7.Value = "" Then
            txt7.Value = "Example1: " & vbCrLf & "Example2: " & vbCrLf & "Example3: "
        End If
End Sub
Private Sub cbContactType_Change()
    cmdbNew.Enabled = CBool(cbContactType.ListIndex <> -1)
    mstrNo.Value = True
    If cbContactType.Enabled Then Set ws = Worksheets(cbContactType.Text)
    
    If cbContactType.Value = "Housing Associations" Or _
       cbContactType.Value = "Landlords" Then
       mstrAccounts.Visible = True
       MLA.Visible = True
    Else
        mstrAccounts.Visible = False
        MLA.Visible = False
    End If
    
    lastRow = ws.Range("B" & Rows.Count).End(xlUp).Row
'    If ws.Name = "Council Contacts" Or ws.Name = "Local Contacts" Or ws.Name = "Housing Associations" Or ws.Name = "Landlords" Or ws.Name = "Letting and Selling Agents" Or ws.Name = "Developers" Or ws.Name = "Employers" Then lastRow = lastRow - 1
    CurrentRow = lastRow + 1
    
    'loop thru and clear textboxes
    For i = 1 To 6
        Contacts.Controls("txt" & i).Value = ""
    Next i
    
    Contacts.dtaRow.Caption = lastRow - 1 & " Record"
    
    cmdbChange.Enabled = True
    cmdbUpdate.Enabled = True
    ws.Activate
    lb.RowSource = "B2:G" & lastRow
End Sub
Private Sub lb_Click()
    CurrentRow = lb.ListIndex + 2
    UpdatecmdbChange
End Sub
Private Sub cmdbChange_SpinDown()
    If CurrentRow > 2 Then
        CurrentRow = CurrentRow - 1
        UpdatecmdbChange
    Else
        CurrentRow = lastRow
        UpdatecmdbChange
    End If
    lb.ListIndex = CurrentRow - 2
End Sub
Private Sub cmdbChange_SpinUp()
    If CurrentRow < lastRow Then
        CurrentRow = CurrentRow + 1
        UpdatecmdbChange
    Else
        CurrentRow = 2
        UpdatecmdbChange
    End If
    lb.ListIndex = CurrentRow - 2
End Sub
Private Sub iptSearch_Click()
    Contacts.Hide
    Unload Contacts
End Sub
Private Sub cmdbUpdate_Click()
    'yet to be completed
End Sub
Private Sub mstrYes_Click()
    txt7.Visible = True
End Sub
Private Sub mstrNo_Click()
    txt7.Visible = False
End Sub
Private Sub cmdbDelete_Click()
Dim smessage As String
    smessage = "Are you sure you want to delete this contact?" & vbCrLf & vbCrLf & "Name: " & txt2.Text & vbCrLf & "From: " & txt1.Text
    
    If MsgBox(smessage, vbQuestion & vbYesNo, _
              "Delete") = vbYes Then
    ws.Rows(CurrentRow).Delete
    End If
    lastRow = lastRow - 1
    lb.RowSource = "B2:G" & lastRow
End Sub
Private Sub cmdbNew_Click()
    If txt1.Value = "" And txt2.Value = "" And txt3.Value = "" _
        And txt4.Value = "" And txt5.Value = "" And txt6.Value = "" Then
        MsgBox "Please enter data into at least one field.", 48, "Error"
        Exit Sub
    End If
    nextrow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    If Len(ws.Cells(1, 2).Value) > 0 Then nextrow = nextrow + 1
        If txt7.Visible = True Then
            cNum = 7
        Else
            cNum = 6
        End If
    For X = 1 To cNum
        AlignLeft = CBool(X = 1 Or X = 7)
        With ws.Cells(nextrow, X + 1)
            .Value = Me.Controls("txt" & X).Value
            .EntireColumn.AutoFit
            .HorizontalAlignment = IIf(X = 1 Or X = 7, xlLeft, xlCenter)
            .VerticalAlignment = xlCenter
                With .Font
                     .Name = "Arial"
                     .FontStyle = "Regular"
                     .Size = 10
                End With
        End With
        Controls("txt" & X).Text = ""
    Next
    MsgBox "Contact added to " & ws.Name, 64, "Success"
    Application.ScreenUpdating = False
    Unload Me
    Contacts.Show
    Application.ScreenUpdating = True
End Sub
Private Sub cmdbClose_Click()
Unload Me
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
1K
AndyEd
A
M
  • Solved
How to update worksheet table data using userform listbox
Replies
3
Views
977
dmt32
D
I
  • Solved
Userform to worksheet values followed by 3 digits
Replies
2
Views
392
ipbr21054
I
A
  • Solved
make faster code after increase data for 4000 rows for each sheet on userform
2
Replies
13
Views
1K
Akuini
Akuini
A
  • Solved
add another condition to filter data based on month in listbox on userform
Replies
3
Views
572
abdelfattah
A

Forum statistics

Threads
1,224,852
Messages
6,181,397
Members
453,034
Latest member
mikdadhussain

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