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
You can simplify the code a bit by adding a loop to toggle the visible properties:

Code: 
    For i = 1 To 7
        Contacts.Controls("txt" & i).Visible = False
    Next i

CJ
 
Last edited:
Upvote 0

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
I have updated the file on dropbox so you can see the changes. I have inserted similar code to the update button, although at the moment the button remains greyed out no matter what you do so I can't test its behaviour.

Is this right?

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()
    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 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 CurrentRow = CurrentRow + 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(CurrentRow, 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 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
 
Upvote 0
No. This:
Code: 
Private Sub txt1_[COLOR=#ff0000]cmdbUpdate[/COLOR]()
    cmdbUpdate.Enabled = True
End Sub

Should be this:

Code: 
Private Sub txt1_[COLOR=#ff0000]AfterUpdate[/COLOR]()
    cmdbUpdate.Enabled = True
End Sub

AfterUpdate is an event procedure and not the name of any control.

CJ
 
Upvote 0
Thank you for clarifying:

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_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 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 CurrentRow = CurrentRow + 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(CurrentRow, 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 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

Still the button is permanently greyed out on testing.
 
Upvote 0
Okay, this fixes that problem:

Code: 
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

Now I need to get the update code working properly.
 
Upvote 0
The reason for this and the like:

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

was to enable the update button only if the user changed something in one or more of the textboxes. Your latest code will enable it as soon as row data is shown meaning they will be able to click Update even if nothing has changed. When you tried to test the code as posted in post #64, did you select a row (either by spinbutton or clicking an entry in the listbox) then type some new text in one of the textboxes then hit tab or enter?

In fact, I would go so far as to add:

Code: 
Contacts.cmdbUpdate.Enabled = False

to Public Sub UpdatecmdbChange in the Fetch module.

CJ
 
Upvote 0
Ah, great. Thank you for clarifying.

It seems to update using the code I posted in the worksheet but not on the listbox, is there something wrong with the code?

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 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 CurrentRow = CurrentRow + 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(CurrentRow, 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 modified in " & ws.Name, 64, "Success"
End Sub

I tried to update the text in an example with data in txt7 and no matter whether I tabbed or clicked in another field the update button did not turn to enabled.

Also, is the formatting necessary when editing? I suppose it is as any new data will revert to default formatting?
 
Last edited:
Upvote 0
It looks like some of the worksheets think there is data where there isn't as well.
7uRevwP.png
 
Upvote 0
Also, some of the worksheets will have different coloured rows depending on the organisation. I found someone else looking to reproduce the formatting of a particular cell/range that reproduces the background colour, text style, font and text size (or so they say).

The code is
Code: 
[COLOR=#333333]Me.Textbox1.text = sheets("data").Range("A1").Text[/COLOR]

How do I translate that into code that works for all the text boxes on the userform? I think it has something to do with the following but I cannot figure out how to change it so it works.

Code: 
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
 
Upvote 0
I think this is something along the right lines:
Code: 
    lblOrganisationName.Visible = True        txt1.Visible = True
        txt1.BackColor = ws.Range("B" & Rows.Count).Interior.Color
        txt1.BackColor = ws.Range("B" & Rows.Count).Font.Color

Problem is, no matter what I do on the userform, it just makes txt1 appear with a black background. When hovering over the code, it tells me the value is 16777215. I have tried highlighting various cells in various worksheets and this makes no difference.
 
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,922
Messages
6,175,384
Members
452,639
Latest member
RMH2024

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