PDA

View Full Version : Userform for Data Entry Into Several Different Worksheets



MSXL
04-03-2017, 02:22 PM
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.

The first function I am trying to implement is described 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. Another problem with this is even when 'mstrNo' is selected, it inputs the default value into that column on the spreadsheet, which it shouldn't do.

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 whilst clearing anything else typed into that box after those preexisting 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.


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 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
If Me.txt7.Value = "" Then
Me.txt7.Value = "Example1: " & vbCrLf & "Example2: " & vbCrLf & "Example3: "
End If
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"
Application.ScreenUpdating = False
Unload Me
Contacts.Show
Application.ScreenUpdating = True
End Sub


Private Sub cmdbClose_Click()
Unload Me
End Sub


If someone could please help me I would be extremely grateful.

Worksheet: https://www.dropbox.com/s/gooebb7hcm07cqm/BKContacts.xlsm?dl=0