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
Sheepdisease said:
How do I prevent the text within 'txt7' that appears automatically in 'Example1, Example2, Example3' mentioned previously from being cleared during the following procedure whilst clearing anything else typed into that box after those pre-existing words? I have implemented a workaround which is to unload and reload the form after data entry, but this means having to reselect the particular contact group type from the combobox again when there may be several that need to be input at the same time, making this a hassle.
Click to expand...
I'm not sure I understand this: are you saying that you want to retain "Example1, Example2, Example3" while getting rid of anything else typed in? If so, instead of unloading and reloading the form, just use txt7.value = "Example1: " & vbCrLf & "Example2: " & vbCrLf & "Example3: ". If I am still missing your point on this, please explain again.

Sheepdisease said:
Also, how do I force the user to enter data in at least one of the fields (doesn't matter which one) before they are able to save the data to the selected worksheet for a new entry?
Click to expand...
Put this code at the start of your Private Sub cmdbNew_Click() event:
Code: 
    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."
        Exit Sub
    End If

Sheepdisease said:
Lastly, how do I prevent
Click to expand...
Sheepdisease said:
'Example1, Example2, Example3' from being inserted into the worksheet as long as 'mstrYes' is not selected?
Click to expand...
In your Private Sub cmdbNew_Click() event, replace
Code: 
cNum = 7
with
Code: 
    If txt7.Visible = True Then
        cNum = 7
    Else
        cNum = 6
    End If

Also, you should note that you have a misspelling here (in red):
Code: 
Dim AlignLeft As Boolean
    For X = 1 To cNum
    [COLOR=#ff0000]AlingLeft[/COLOR] = CBool(X = 1 Or X = 7)
This is one of many advantages of using Option Explicit which would flag that variable for you.

Regards,

CJ
 
Last edited:
Upvote 0

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
That's brilliant. Thank you.

I am trying to modify some code from another userform so that the data from a particular row on the spreadsheet selected from the combobox appears in the text boxes, which will enable that row to be updated by overtyping the original data and clicking 'update'.

However, I am not sure how I pull this data from the selected combobox and wondered if you could please kindly explain where I need to make changes? This is a mess and it's because I am not sure what code I should be inserting at the beginning to pull the data. I think it would be best if it defaulted to the last complete row at the bottom of the particular worksheet selected from the combobox although I am open to suggestion.

Code: 
'Private Sub cmdbChange_SpinUp()
'    If Worksheets(cbContactType.Text).ListRows.Count < 1 Then Exit Sub
'    If CurrentRow > 1 Then
'        CurrentRow = CurrentRow - 1
'        UpdateRecordDisplay
'    End If
'End Sub

'Private Sub cmdbChange_SpinDown()
'    If CurrentRow = Worksheets(cbContactType.Text).ListRows.Count Then Exit Sub
'    If CurrentRow < Worksheets(cbContactType.Text).ListRows.Count Then
'        CurrentRow = CurrentRow + 1
'        UpdateRecordDisplay
'    End If
'End Sub

'Private Sub UpdateRecordDisplay()
'
'    With Me.cbContactType
'
'        RecordPosition.Caption = CurrentRow & " of " & .ListRows.Count
'        PopulateForm .ListRows(CurrentRow).Range
'        .ListRows(CurrentRow).Range.Select
'
'    End With
'
'End Sub

I'm also trying to get the form to show which row it is on (the number should not include the heading in row 1 when counting)

Code: 
Private Sub dtaRowCaption()
    dtaRow.Caption = CurrentRow & " of " & Me.cbContactType.ListRows.Count
End Sub

Full code including your suggestions:

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)
    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
    
   Dim Tgt As Range
   With ws
   Set fCell = .Range("A:I").Find(cbContactType.Value, , xlValues, xlWhole)
   If fCell Is Nothing Then Exit Sub
    X = fCell.Row
    Me.txt1.Value = .Cells(X, 1).Value
    Me.txt2.Value = .Cells(X, 2).Value
    Me.txt3.Value = .Cells(X, 3).Value
    Me.txt5.Value = .Cells(X, 5).Value
    Me.txt6.Value = .Cells(X, 6).Value
    Me.txt4.Value = .Cells(X, 4).Value
    Me.txt7.Value = .Cells(X, 7).Value
   
End With
    
End Sub

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

Private Sub cmdbChange_Change()

End Sub

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

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

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

'Private Sub cmdbChange_SpinDown()
'    If CurrentRow = Worksheets(cbContactType.Text).ListRows.Count Then Exit Sub
'    If CurrentRow < Worksheets(cbContactType.Text).ListRows.Count Then
'        CurrentRow = CurrentRow + 1
'        UpdateRecordDisplay
'    End If
'End Sub

'Private Sub UpdateRecordDisplay()
'
'    With Me.cbContactType
'
'        RecordPosition.Caption = CurrentRow & " of " & .ListRows.Count
'        PopulateForm .ListRows(CurrentRow).Range
'        .ListRows(CurrentRow).Range.Select
'
'    End With
'
'End Sub

Private Sub dtaRowCaption()
    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
    Dim objCtrl As Control
        mstrNo = True
        For Each objCtrl In Me.Controls
        If Left(objCtrl.Name, 4) = “Text” Then txt7.Visible = False
        Next
            If Me.txt7.Value = "" Then
            Me.txt7.Value = "Example1: " & vbCrLf & "Example2: " & vbCrLf & "Example3: "
            End If
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."
        Exit Sub
    End If
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
        If txt7.Visible = True Then
        cNum = 7
            Else
            cNum = 6
        End If
        Dim AlignLeft As Boolean
    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
    Me.Controls("txt" & X).Text = ""
    Next
    MsgBox "Contact added to " & ws.Name, 64, "Contact Added"
    Application.ScreenUpdating = False
    Unload Me
    Contacts.Show
    Application.ScreenUpdating = True
End Sub

Private Sub cmdbClose_Click()
Unload Me
End Sub
 
Last edited:
Upvote 0
Hi again! Sorry this took me a while to reply to, but I had to read, then reread, then reread again your post to try to understand what it was you were asking (I can be quite dense sometimes! :biggrin:) I took some liberties with your code by changing it around a bit to make it more readable to me, so I highly recommend that you try my suggested code below in a COPY of your workbook in case it's not what you are looking for.

Replace your entire userform module code (in your new copy) with the following:

Code: 
Option Explicit
Dim objCtrl As Control
Dim cNum As Integer, X 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
        
        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)
    
    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
    CurrentRow = lastRow
    
    UpdatecmdbChange
    
End Sub
Private Sub cmdbChange_SpinDown()
    If CurrentRow > 2 Then
        CurrentRow = CurrentRow - 1
        UpdatecmdbChange
    End If
End Sub
Private Sub cmdbChange_SpinUp()
    If CurrentRow < lastRow Then
        CurrentRow = CurrentRow + 1
        UpdatecmdbChange
    End If
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 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."
        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, "Contact Added"
    Application.ScreenUpdating = False
    Unload Me
    Contacts.Show
    Application.ScreenUpdating = True
End Sub
Private Sub cmdbClose_Click()
Unload Me
End Sub

Then, create a new module with the following code:

Code: 
Option Explicit
Public ws As Worksheet
Public lastRow As Long, CurrentRow As Long
Dim i As Integer
Public Sub UpdatecmdbChange()
'loop thru and populate textboxes with data from current row of selected worksheet
    For i = 1 To 7
        Contacts.Controls("txt" & i).Value = ws.Cells(CurrentRow, i + 1).Value
    Next i
Contacts.dtaRow.Caption = CurrentRow - 1 & " of " & lastRow - 1
End Sub

Try it out and let me know if it works for you or if you have further questions.

Regards,

CJ
 
Upvote 0
Thank you for your reply, I am copying the existing code into this post in case there is a problem.

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)
    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
End Sub


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


Private Sub mstrYes_Click()
For Each objCrl In Me.Controls
If mstrYes.Value Then txt7.Visible = True
Next
End Sub


Private Sub mstrNo_Click()
For Each objCrl In Me.Controls
If mstrNo.Value Then txt7.Visible = False
Next
mstrYes.Visible = True
mstrNo.Visible = True
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
    Dim objCtrl As Control
        mstrYes.Value = False
        mstrNo.Value = False
        For Each objCtrl In Me.Controls
        If Left(objCtrl.Name, 4) = “Text” Then txt7.Visible = False
        Next
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 Or X = 7, 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
 
Upvote 0
Okay, we're definitely getting there now. Thank you very much.

Userform:
Code: 
Option ExplicitDim objCtrl As Control
Dim cNum As Integer, X 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
        
        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)
    
    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
    CurrentRow = lastRow
    
    UpdatecmdbChange
    
End Sub
Private Sub cmdbChange_SpinDown()
    If CurrentRow > 2 Then
        CurrentRow = CurrentRow - 1
        UpdatecmdbChange
    End If
End Sub
Private Sub cmdbChange_SpinUp()
    If CurrentRow < lastRow Then
        CurrentRow = CurrentRow + 1
        UpdatecmdbChange
    End If
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 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

Fetch module:
Code: 
Option Explicit
Public ws As Worksheet
Public lastRow As Long, CurrentRow As Long
Dim i As Integer
Public Sub UpdatecmdbChange()
'loop thru and populate textboxes with data from current row of selected worksheet
    For i = 1 To 7
        Contacts.Controls("txt" & i).Value = ws.Cells(CurrentRow, i + 1).Value
    Next i
Contacts.dtaRow.Caption = CurrentRow - 1 & " of " & lastRow - 1
End Sub

The first thing I notice is that as soon as you choose a worksheet from the combobox it immediately retrieves data even if there is no added in a particular worksheet, it picks up the heading titles from the first row. In these instances, can it just keep the text boxes blank?

When choosing a worksheet from the combobox, can it not display any data from that worksheet unless the left arrow button is pressed and then it will show the data from the last (bottom) row with data in it? Otherwise validation is useless as the userform will allow duplicates to be inserted erroneously.

Also, for some reason even if there appears to be no data in the worksheet, the counter includes the first row, it says '1 of 1'. Check the 'landlords' worksheet and then run the userform and choose 'landlords' from the combobox to see what I mean. If there is no data, it show not display the counter. If there is data, it should not count the first row (headers) when stating which result is showing.

AN up to date version of the workbook: https://www.dropbox.com/s/gooebb7hcm07cqm/BKContacts.xlsm?dl=0
 
Last edited:
Upvote 0
Sheepdisease said:
The first thing I notice is that as soon as you choose a worksheet from the combobox it immediately retrieves data even if there is no added in a particular worksheet, it picks up the heading titles from the first row. In these instances, can it just keep the text boxes blank?

When choosing a worksheet from the combobox, can it not display any data from that worksheet unless the left arrow button is pressed and then it will show the data from the last (bottom) row with data in it? Otherwise validation is useless as the userform will allow duplicates to be inserted erroneously.
Click to expand...
Okay...I guess I misunderstood you earlier. I thought you wanted to default to the bottom row of data upon selection from the combobox. To fix this simply delete the call to the UpdatecmdbChange sub at the bottom of the cbContactType_Change sub.

Sheepdisease said:
Also, for some reason even if there appears to be no data in the worksheet, the counter includes the first row, it says '1 of 1'. Check the 'landlords' worksheet and then run the userform and choose 'landlords' from the combobox to see what I mean. If there is no data, it show not display the counter. If there is data, it should not count the first row (headers) when stating which result is showing.

AN up to date version of the workbook: https://www.dropbox.com/s/gooebb7hcm07cqm/BKContacts.xlsm?dl=0
Click to expand...
I actually put some dummy data into each worksheet and I thought that the counter was working properly. I'll d/l the updated version and take a look at it tonight. I'm sure it won't be a problem to fix this.

Regards,

CJ
 
Upvote 0
Great, thanks. Can you please help me implement the delete button too?
 
Upvote 0
MrIfOnly said:
Okay...I guess I misunderstood you earlier. I thought you wanted to default to the bottom row of data upon selection from the combobox. To fix this simply delete the call to the UpdatecmdbChange sub at the bottom of the cbContactType_Change sub.
Click to expand...

Disregard this advice. Instead replace the previous cbContactType_Change code with the following:

Code: 
Private Sub cbContactType_Change()
    cmdbNew.Enabled = CBool(cbContactType.ListIndex <> -1)
    
    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
    CurrentRow = lastRow
    
    'loop thru and clear textboxes
    For i = 1 To 7
        Contacts.Controls("txt" & i).Value = ""
    Next i
    
    Contacts.dtaRow.Caption = lastRow - 1 & " Record(s)"
End Sub


The counter problem is occurring because you have some worksheets formatted as tables. If you remove the tables you'll find that the counter works properly.

Regards,

CJ
 
Last edited:
Upvote 0
Thank you for your reply.

Is there a way for the code to work whether there is a table or not? Can it check whether a particular worksheet contains a table or not and then behave accordingly?

I think this is the code overall that should be used to date:
Code: 
Option Explicit
Dim objCtrl As Control
Dim cNum As Integer, X 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
        
        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)
    
    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
    CurrentRow = lastRow
    
    'loop thru and clear textboxes
    For i = 1 To 7
        Contacts.Controls("txt" & i).Value = ""
    Next i
    
    Contacts.dtaRow.Caption = lastRow - 1 & " Record(s)"
End Sub
Private Sub cmdbChange_SpinDown()
    If CurrentRow > 2 Then
        CurrentRow = CurrentRow - 1
        UpdatecmdbChange
    End If
End Sub
Private Sub cmdbChange_SpinUp()
    If CurrentRow < lastRow Then
        CurrentRow = CurrentRow + 1
        UpdatecmdbChange
    End If
End Sub
Private Sub iptSearch_Click()
    Contacts.Hide
    Unload Contacts
End Sub
Private Sub cmdbUpdate_Click()
    'yet to be completed
End Sub
Private Sub cmdbDelete_Click()
    cmdbNew.Enabled = CBool(cbContactType.ListIndex <> -1)
    
    If cbContactType.Enabled Then Set ws = Worksheets(cbContactType.Text)
    
End Sub
Private Sub mstrYes_Click()
    txt7.Visible = True
End Sub
Private Sub mstrNo_Click()
    txt7.Visible = False
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
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,862
Messages
6,181,457
Members
453,042
Latest member
AbdelrahmanExcel

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