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
Now made the delete button behave in the same way and found a way to make the 'Master' header appear in the listbox:

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
    cmdbDelete.Enabled = False
    txt7.Visible = False
    mstrAccounts.Visible = False
    MLA.Visible = False
    mstrNo.Value = True
    lb.ColumnCount = 7
    lb.ColumnHeads = True
    lb.ColumnWidths = "135 pt;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
    cmdbDelete.Enabled = True
    ws.Activate
    lb.RowSource = "B2:H" & 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:H" & 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

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sheepdisease said:
Now made the delete button behave in the same way and found a way to make the 'Master' header appear in the listbox:
Click to expand...

Excellent! Glad to see it coming together for you and very happy to see you figure out how to 'bend' the existing code to make it work for you! :cool:

Let me know if get stuck on anything else or if I missed any questions along the way.

Regards,

CJ
 
Upvote 0
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'.
Click to expand...

When it changes back to no the default values in the background should revert 'Example 1:' etc.

Can you please help me with this?
 
Upvote 0
Let me make sure I understand this correctly:

So if Housing Associations or Landlords is selected and the current row has data in the 'Master' column, then the 'Yes' radio button should be true and the data from that column should show in txt7? And if the current row has no data in that column then the 'No' radio button should be true and txt7 should be populated with 'Exampe 1:' etc. so that if the user then selects 'Yes' that is what is shown?

If the above is correct, then please make sure your dropbox file is up-to-date with the latest and greatest version and I will download it and make the above changes.

CJ
 
Upvote 0
Thank you for your reply. Even when I don't say so, the dropbox file is up to date as all changes are uploaded each time I post. I think what you have described is correct, particularly in relation to the listbox.
 
Upvote 0
I think I covered everything with the following code. Please let me know if I missed anything.

Replace the code in the Fetch module with:

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 6
        Contacts.Controls("txt" & i).Value = ws.Cells(CurrentRow, i + 1).Value
    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

Regards,

CJ
 
Upvote 0
On first testing that works really well, thank you. How do I implement the update button so whichever row's data is showing, so long as at least one column of data from that row is modified it allows the row to be updated in the worksheet?

With regards to the new button, how do I prevent duplicate data by being inserted if the user has clicked on the spinbutton which will then automatically populate existing data? Can it check for duplicate data within the same worksheet and bring up an error message if it completely matches an existing row?
 
Upvote 0
You may want to have the Update button disabled until something changes in one or more of the textboxes.

Add this to the initialize event:

Code: 
cmdbUpdate.Enabled = False

And add something like this for each textbox:

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

Also, remove cmdbUpdate.Enabled = True from the cbContactType_Change code.

The Update button code should be very similar to the New button code except you'll be using CurrentRow (which will already have been defined) instead of nextrow. See if you can come up with something and let me know if you get stuck.

With regards to the new button, how do I prevent duplicate data by being inserted if the user has clicked on the spinbutton which will then automatically populate existing data? Can it check for duplicate data within the same worksheet and bring up an error message if it completely matches an existing row?
Click to expand...

You'll need to decide what data should be static. In other words, if the user tries to enter an existing housing association, but all other data is different, is that okay? How about contact name? Or is a duplicate record one in which all of the data is identical to an existing record?

Regards,

CJ
 
Last edited:
Upvote 0
Thanks for your reply.

Funnily enough I had just been modifying the userform behaviour and have produced the following code:

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")
    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;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 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 = ""
    Next i
    
    Contacts.dtaRow.Caption = lastRow - 1 & " Record"
    
    lblOrganisationName.Visible = True
    txt1.Visible = True
    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
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 cmdbReset_Click()
    Application.ScreenUpdating = False
    Unload Me
    Contacts.Show
    Application.ScreenUpdating = True
End Sub


Private Sub cmdbUpdate_Click()
    'yet to be completed
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

A duplicate in this instance would be where each column contains exactly the same data, as this would enable a number of contacts within an organisation to be added easily.
 
Upvote 0
Your suggestion in practice without the update functionality introduced yet:

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")
    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;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 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 = ""
    Next i
    
    Contacts.dtaRow.Caption = lastRow - 1 & " Record"
    
    lblOrganisationName.Visible = True
    txt1.Visible = True
    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
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 cmdbReset_Click()
    Application.ScreenUpdating = False
    Unload Me
    Contacts.Show
    Application.ScreenUpdating = True
End Sub


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


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


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


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


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


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


Private Sub cmdbUpdate_Click()
    'yet to be completed
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
 
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
390
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,845
Messages
6,181,301
Members
453,031
Latest member
Chris_1

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