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
When you add new rows of data to tables it automatically alternates the background color of each row. Are you trying to override this behavior?

I'm not sure what happened to the row counter on some sheets. I'll have to take a closer look at this and get back to you.

CJ
 
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.
Thanks for your reply CJ. On some sheets using the real data the rows actually contain background colours and some are bold. This should show on the userform textboxes. If the colours alternate then this pattern should show on the userform text fields when switching between entries on that particular sheet.
 
Upvote 0
The text colour can be different as well.

I have tried to implement that to the same result as reported previously:

Code: 
txt1.BackColor = ws.Range("B" & Rows.Count).Interior.Color        txt1.BackColor = ws.Range("B" & Rows.Count).Font.Color
        txt1.ForeColor = ws.Range("B" & Rows.Count).Font.Color
 
Upvote 0
Regarding the row counter issue: this is related to the table formatting. Excel is counting the first data row in the table regardless of whether or not data exists in it. This will happen even if we use table.Range.Rows.Count (which actually opens another can of worms because of the your naming convention of the tables in the workbook). We can maybe come up with a workaround, but before we go through that exercise (and ultimately, ugly code): is it really necessary? If you are going to have data in all the worksheets before going live with this project then the issue is moot.

In regards to the textbox formatting matching the cell formatting: I'll play around with it to see if I can make something work.

CJ
 
Upvote 0
I agree that it is a pointless exercise once data is in each of the worksheets, so long as it is only a problem in that particular instance.

Thanks for your help, look forward to seeing the solution for the formatting and getting the update button working correctly.
 
Upvote 0
I have been trying to find a solution and playing with the code but I can't fix it, to me it looks like the code I mentioned should be correct.
 
Upvote 0
With regards to the formatting question: you were on the right track with this. With a few tweaks and moving the code I got it to work. Remove what you have in regards to this and then paste the following code in the UpdatecmdbChange sub in the Fetch module (to replace the previous code under the 'loop thru and populate textboxes with data from current row of selected worksheet comment):

Code: 
    For i = 1 To 6
        Contacts.Controls("txt" & i).Value = ws.Cells(CurrentRow, i + 1).Value
        Contacts.Controls("txt" & i).BackColor = ws.Cells(CurrentRow, i + 1).Interior.Color
        Contacts.Controls("txt" & i).ForeColor = ws.Cells(CurrentRow, i + 1).Font.Color
    Next i

Then, paste the following in the cbContactType_Change event code in the userform module (to replace the previous code under the 'loop thru and clear textboxes comment):

Code: 
    For i = 1 To 6
        Contacts.Controls("txt" & i).Value = ""
        Contacts.Controls("txt" & i).BackColor = vbWhite
        Contacts.Controls("txt" & i).ForeColor = vbBlack
    Next i

With regards to the Update button function: again, you were close, but had a few lines left over from the New button code that were working against you. Replace the entire cmdbUpdate_Click event code with:

Code: 
Private Sub cmdbUpdate_Click()
    
    If txt1.Value = "" And txt2.Value = "" And txt3.Value = "" _
        And txt4.Value = "" And txt5.Value = "" And txt6.Value = "" Then
        MsgBox "Please update data in at least one text box.", 48, "Error"
        Exit Sub
    End If
    
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With
    
    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(CurrentRow, x + 1)
            .Value = Me.Controls("txt" & x).Value
        End With
    Next
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With
    
    MsgBox "Contact modified in " & ws.Name, 64, "Success"
End Sub

Try it out and let me know how it works for you.

Regards,

CJ
 
Upvote 0
That's great, thank you so much. Just a couple of points:

When loading up the userform, choosing an option from the combobox, before pressing the spinbutton, it turns the Organisation Name text box black until the spinbutton is pressed.

cTB2aaO.png


Can we also get the formatting to show in the listbox (remembering that each row could be a different colour)?

Also, at the moment you have to type something new and then press tab or click in another box before you can click on update. Can we get the form to recognise when new data is entered and enable the update button without the extra step so long as text is entered into at least one text box and is more than three characters long?
 
Upvote 0
Contacts:
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")
    lblOrganisationName.Visible = False
        txt1.Visible = False
    lblContactName.Visible = False
        txt2.Visible = False
    lblTelephoneNumber.Visible = False
        txt3.Visible = False
    lblEmailAddress.Visible = False
       txt4.Visible = False
    lblPostalAddress.Visible = False
      txt5.Visible = False
    lblPassword.Visible = False
        txt6.Visible = False
    cmdbReset.Enabled = False
    cmdbUpdate.Enabled = False
    cmdbNew.Enabled = False
    cmdbChange.Enabled = False
    cmdbDelete.Enabled = False
    MLA.Visible = False
    mstrAccounts.Visible = False
    mstrNo.Value = True
        txt7.Visible = False
    lb.Visible = False
    lb.ColumnCount = 7
    lb.ColumnHeads = True
    lb.ColumnWidths = "135 pt;142 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 iptSearch_Click()
    Contacts.Hide
    Unload Contacts
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 = ""
        Contacts.Controls("txt" & i).BackColor = vbWhite
        Contacts.Controls("txt" & i).ForeColor = vbBlack
    Next i
    
    Contacts.dtaRow.Caption = lastRow - 1 & " Record"
    
    lblOrganisationName.Visible = True
        txt1.Visible = True
        txt1.BackColor = ws.Range("B" & Rows.Count).Interior.Color
        txt1.BackColor = ws.Range("B" & Rows.Count).Font.Color
        txt1.ForeColor = ws.Range("B" & Rows.Count).Font.Color
    lblContactName.Visible = True
        txt2.Visible = True
    lblTelephoneNumber.Visible = True
        txt3.Visible = True
    lblEmailAddress.Visible = True
        txt4.Visible = True
    lblPostalAddress.Visible = True
        txt5.Visible = True
    lblPassword.Visible = True
        txt6.Visible = True
    cmdbReset.Enabled = True
    cmdbChange.Enabled = True
'    cmdbUpdate.Enabled = True
    cmdbDelete.Enabled = True
    lb.Visible = True
    ws.Activate
    lb.RowSource = "B2:H" & lastRow
End Sub

Private Sub cmdbChange_SpinUp()
    If CurrentRow < lastRow Then
        CurrentRow = CurrentRow + 1
        UpdatecmdbChange
    Else
        CurrentRow = 2
        UpdatecmdbChange
    End If
    lb.ListIndex = CurrentRow - 2
'    cmdbUpdate.Enabled = True
End Sub

Private Sub cmdbChange_SpinDown()
    If CurrentRow > 2 Then
        CurrentRow = CurrentRow - 1
        UpdatecmdbChange
    Else
        CurrentRow = lastRow
        UpdatecmdbChange
    End If
    lb.ListIndex = CurrentRow - 2
'    cmdbUpdate.Enabled = True
End Sub

Private Sub cmdbReset_Click()
    Application.ScreenUpdating = False
    Unload Me
    Contacts.Show
    Application.ScreenUpdating = True
End Sub

Private Sub txt1_AfterUpdate()
    cmdbUpdate.Enabled = True
End Sub

Private Sub txt2_AfterUpdate()
    cmdbUpdate.Enabled = True
End Sub

Private Sub txt3_AfterUpdate()
    cmdbUpdate.Enabled = True
End Sub

Private Sub txt4_AfterUpdate()
    cmdbUpdate.Enabled = True
End Sub

Private Sub txt5_AfterUpdate()
    cmdbUpdate.Enabled = True
End Sub

Private Sub txt6_AfterUpdate()
    cmdbUpdate.Enabled = True
End Sub

Private Sub cmdbUpdate_Click()
    
    If txt1.Value = "" And txt2.Value = "" And txt3.Value = "" _
        And txt4.Value = "" And txt5.Value = "" And txt6.Value = "" Then
        MsgBox "Please update data in at least one text box.", 48, "Error"
        Exit Sub
    End If
    
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With
    
    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(CurrentRow, x + 1)
            .Value = Me.Controls("txt" & x).Value
        End With
    Next
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With
    
    MsgBox "Contact modified in " & ws.Name, 64, "Success"
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 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:H" & lastRow
End Sub

Private Sub cmdbClose_Click()
Unload Me
End Sub

Private Sub mstrYes_Click()
    txt7.Visible = True
End Sub

Private Sub mstrNo_Click()
    txt7.Visible = False
End Sub

Private Sub lb_Click()
    CurrentRow = lb.ListIndex + 2
    UpdatecmdbChange
End Sub

Fetch:
Code: 
Option Explicit
Public ws As Worksheet
Public lastRow As Long, CurrentRow As Long
Dim i As Integer
Public Sub UpdatecmdbChange()
Contacts.cmdbUpdate.Enabled = False
'loop thru and populate textboxes with data from current row of selected worksheet
    For i = 1 To 6
        Contacts.Controls("txt" & i).Value = ws.Cells(CurrentRow, i + 1).Value
        Contacts.Controls("txt" & i).BackColor = ws.Cells(CurrentRow, i + 1).Interior.Color
        Contacts.Controls("txt" & i).ForeColor = ws.Cells(CurrentRow, i + 1).Font.Color
    Next i
'handle masters
    With Contacts
        If ws.Name = "Housing Associations" Or ws.Name = "Landlords" Then
            If ws.Cells(CurrentRow, 8).Value <> "" Then
                .mstrYes = True
                .txt7.Visible = True
                .txt7.Value = ws.Cells(CurrentRow, 8).Value
            Else
                .mstrNo = True
                .txt7.Visible = False
                .txt7.Value = "Example1: " & vbCrLf & "Example2: " & vbCrLf & "Example3: "
            End If
        End If
    End With
'counter
    Contacts.dtaRow.Caption = CurrentRow - 1 & " of " & lastRow - 1
End Sub
 
Upvote 0
Sheepdisease said:
When loading up the userform, choosing an option from the combobox, before pressing the spinbutton, it turns the Organisation Name text box black until the spinbutton is pressed.
Click to expand...

Remove the following lines from cbContactType_Change():

Code: 
        txt1.BackColor = ws.Range("B" & Rows.Count).Interior.Color
        txt1.BackColor = ws.Range("B" & Rows.Count).Font.Color
        txt1.ForeColor = ws.Range("B" & Rows.Count).Font.Color

Sheepdisease said:
Can we also get the formatting to show in the listbox (remembering that each row could be a different colour)?
Click to expand...

I don't think this is possible, but I could be wrong.

Sheepdisease said:
Also, at the moment you have to type something new and then press tab or click in another box before you can click on update. Can we get the form to recognise when new data is entered and enable the update button without the extra step so long as text is entered into at least one text box and is more than three characters long?
Click to expand...

Use the following as a template to replace all of the textbox_AfterUpdate events:

Code: 
Private Sub txt1_Change()
    If Len(txt1) > 3 Then cmdbUpdate.Enabled = True
End Sub

Regards,

CJ
 
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
950
dmt32
D
I
  • Solved
Userform to worksheet values followed by 3 digits
Replies
2
Views
381
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
565
abdelfattah
A

Forum statistics

Threads
1,223,912
Messages
6,175,348
Members
452,638
Latest member
Oluwabukunmi

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