Linking Userforms and Worksheets: Part V

Posted on by Dick Kusleika

Part I: Setting Up the Form
Part II: Helper Procedures
Part III: Determining If the Form Needs to be Saved
Part IV: The Initialize Event

In this final part, I discuss the change event for the scrollbar. The scrollbar is the means by which the user moves between records. It doesn’t have to be a scrollbar, of course, but it’s one option. We’ll need one more module level variable:

Private mlLastScrollValue As Long

Private Sub scbContact_Change()

Dim sPrompt As String
Dim sTitle As String
Dim lResp As Long

sPrompt = "Save Changes"
sTitle = "Record Has Changed"

If Me.IsDirty Then
lResp = MsgBox(sPrompt, vbYesNo, sTitle)
If lResp = vbYes Then
SaveRecord CLng(Me.scbContact.Value > mlLastScrollValue)
End If
End If

PopulateRecord

mlLastScrollValue = Me.scbContact.Value

End Sub

This procedure checks to see if the current record needs to be saved and prompts the user if it does. Then it populates the record based on the current value of the scrollbar. The module level variable holds the prior scrollbar value so the SaveRecord procedure can determine if the user is scrolling up or down. Basically, it has to know whether to save the previous or the next record because the value of the scrollbar has already changed.

Finally, the two commandbuttons have these procedures in their click events:

Private Sub cmdClose_Click()

Unload Me

End Sub

Private Sub cmdSave_Click()

If Me.IsDirty Then
SaveRecord
End If

End Sub

Here’s what the final userform looks like

LUWP5P01

And you can download it here: LinkUserform.zip

23 thoughts on “Linking Userforms and Worksheets: Part V”

  1. Thanks for the zip file. The multiple posts were getting a little hard to follow, so it helps to see all the pieces put together.

    Thanks, too, for your great site!

  3. Man, I was so worried about spelling Duluth wrong (not enough to look it up, mind you) that I didn’t even think about Jimi. I was pretty confident with Bob, though.

  4. Hi All,

    Could you please help me I wouldn’t use a scroll object but that all datas change when I change the ID/Key control change thanks in advance. Franck

  5. Ola!
    Thanx for the tips.
    Till yesterday I was a nitwith in Vb.
    Now I understand your program and comments.
    It’s perfect for the further development of the program I want to make!
    Greetz Stefan

  6. Hi

    I have been looking at your code and the responses from users. I noted that one mentioned a zip file of this code. Is this still available? Like the poster, I am having difficulty putting all this together.

    Thanks…

  8. ick – Thanks for the reply. I have been busy on another project but now I am trying to get back to ‘my’ stuff!

    Many thanks – I hope I can make a go of this.

    Lamar

  9. bloody sensational!

    my god have I been looking for this one

    I have added it to a little project of mine and straight up I get a
    runtime error 1004
    Method ‘Range’ of object’_Worksheet’ failed

    has me stumped but will keep pluggin away at it

    any advice on this is appreciated

    cheers
    Paul V

  11. Great information. Can’t download Link UserForm.zip. It’s password protected. Is it possible to see the file for part VI as well?

  13. Dick,

    I’m having trouble with the enable of the Save command button. If I call up the userform using the F5 it works fine. If I create a subroutine from a general module and load the UContact form from there, the enable functionality seems to break. I can’t seem to figure out the issue. Any ideas?

    Thanks,
    Gary

  14. I think I figured out the issue in the previous post. Some sort of scope / instanciation issue. I changed the references in the class module to object.parent rather than the form name and it seems to work. I guess when I used the FormName.Property syntax it must have been creating a new instance of the form and manipulating it’s properties, not the form that called it.

    Gary

  15. Gary: That’s right. Thanks to Jan Karel Pieterse and Andy Pope for helping find this answer. Change the code in CControlEvents to

    Private Sub gCombo_Change()

        gCombo.Parent.IsDirty = True
       
    End Sub

    Private Sub gTextBox_Change()

        gTextBox.Parent.IsDirty = True
       
    End Sub

  16. You are Fantastic
    After so many months I found your file – I couldn’t learn how to do it – and now your example make me incredible HAPPY.
    Great THX
    I love you for that ;-)

  19. as this time 11:54am CST, link to the LinkUserform.zip file still takes you to a page not found

    thanks in advance,
    —Woody

  22. Can this be applied to a panning hand the grab & pull method? or is that a totally different forum. If this is already a foruum please send link to point me in the correct direction. I am using MS 2010 32 bit, on a Win 7 x64 OS compatibilty mode set for XP (service pak 2) Disable visual themes not checked, working with Visual 2005, MS 95-97, 2003-2005, 2007-2010. I am looking how & where to set value (action) grab & pull metod the panning hand I created in VB with UI, not sure about how to administer the action, all I have found is to act with in row & columns not over the entire spreadsheet.
    Thanks
    A waiting your reply.

  23. Hi can you help me with this? I’ve been doing this for a week now the add, close button and the text box are functioning the only problem is the scroll bar button is not functioning and the data does not load in the userforms. No error message is coming out..thanks in advance
    Option Explicit

    Private mbIsDirty As Boolean
    Private mcControls As Collection
    Private mlLastScrollValue As Long

    Private Sub cmdClose_Click()

    Unload Me
    End Sub

    Private Sub cmdSave_Click()
    If Me.IsDirty Then
    SaveRecord
    End If

    End Sub

    Private Sub CmdAdd_Click()
    Dim iRow As Long
    Dim ws As Worksheet
    Set ws = Worksheets("TripticketData")

    ''find first empty row in database
    iRow = ws.Cells(Rows.Count, 1) _
    .End(xlUp).Offset(1, 0).Row

    ''check for a Trip ticket number
    If Trim(Me.txttripticketno.Value) = "" Then
    Me.txttripticketno.SetFocus
    MsgBox "Please enter a Trip Ticket number"
    Exit Sub
    End If
    'Copy the data to the database
    ws.Cells(iRow, 1).Value = Me.txttripticketno.Value
    ws.Cells(iRow, 2).Value = Me.txttech1.Value
    ws.Cells(iRow, 3).Value = Me.txttech2.Value
    ws.Cells(iRow, 4).Value = Me.txtPlate.Value
    ws.Cells(iRow, 5).Value = Me.TxtDateOut.Value
    ws.Cells(iRow, 6).Value = Me.TxtDateIn.Value
    ws.Cells(iRow, 7).Value = Me.txtTimeOut.Value
    ws.Cells(iRow, 8).Value = Me.txtTimein.Value
    ws.Cells(iRow, 9).Value = Me.txtKMout.Value
    ws.Cells(iRow, 10).Value = Me.txtkmIn.Value
    ws.Cells(iRow, 11).Value = Me.txtRugsQty.Value
    ws.Cells(iRow, 12).Value = Me.txtSoapQty.Value
    ws.Cells(iRow, 13).Value = Me.txtfuelQty.Value
    ws.Cells(iRow, 14).Value = Me.txtPailOutQty.Value
    ws.Cells(iRow, 15).Value = Me.txtPailInQty.Value
    ws.Cells(iRow, 16).Value = Me.txtDRSI1.Value
    ws.Cells(iRow, 17).Value = Me.txtCustomer1.Value
    ws.Cells(iRow, 18).Value = Me.txtlocation1.Value
    ws.Cells(iRow, 19).Value = Me.txtJobDescript1.Value
    ws.Cells(iRow, 20).Value = Me.txtServRep1.Value
    ws.Cells(iRow, 21).Value = Me.txtArrival1.Value
    ws.Cells(iRow, 22).Value = Me.txtDEPARTURE1.Value
    ws.Cells(iRow, 23).Value = Me.txtOdometerstart1.Value
    ws.Cells(iRow, 24).Value = Me.txtOdometerend1.Value
    ws.Cells(iRow, 25).Value = Me.txtDRSI2.Value
    ws.Cells(iRow, 26).Value = Me.txtCustomer2.Value
    ws.Cells(iRow, 27).Value = Me.txtlocation2.Value
    ws.Cells(iRow, 28).Value = Me.txtJobDescript2.Value
    ws.Cells(iRow, 29).Value = Me.txtServRep2.Value
    ws.Cells(iRow, 30).Value = Me.txtArrival2.Value
    ws.Cells(iRow, 31).Value = Me.txtDEPARTURE2.Value
    ws.Cells(iRow, 32).Value = Me.txtOdometerstart2.Value
    ws.Cells(iRow, 33).Value = Me.txtOdometerend2.Value

    ws.Cells(iRow, 34).Value = Me.txtDRSI3.Value
    ws.Cells(iRow, 35).Value = Me.txtCustomer3.Value
    ws.Cells(iRow, 36).Value = Me.txtlocation3.Value
    ws.Cells(iRow, 37).Value = Me.txtJobDescript3.Value
    ws.Cells(iRow, 38).Value = Me.txtservRep3.Value
    ws.Cells(iRow, 39).Value = Me.txtArrival3.Value
    ws.Cells(iRow, 40).Value = Me.txtDEPARTURE3.Value
    ws.Cells(iRow, 41).Value = Me.txtOdometerstart3.Value
    ws.Cells(iRow, 42).Value = Me.txtOdometerend3.Value

    ws.Cells(iRow, 43).Value = Me.txtDRSI4.Value
    ws.Cells(iRow, 44).Value = Me.txtCustomer4.Value
    ws.Cells(iRow, 45).Value = Me.txtlocation4.Value
    ws.Cells(iRow, 46).Value = Me.txtJobDescript4.Value
    ws.Cells(iRow, 47).Value = Me.txtservRep4.Value
    ws.Cells(iRow, 48).Value = Me.txtArrival4.Value
    ws.Cells(iRow, 49).Value = Me.txtDEPARTURE4.Value
    ws.Cells(iRow, 50).Value = Me.txtOdometerstart4.Value
    ws.Cells(iRow, 51).Value = Me.txtOdometerend4.Value

    ws.Cells(iRow, 52).Value = Me.txtDRSI5.Value
    ws.Cells(iRow, 53).Value = Me.txtCustomer5.Value
    ws.Cells(iRow, 54).Value = Me.txtlocation5.Value
    ws.Cells(iRow, 55).Value = Me.txtJobDescript5.Value
    ws.Cells(iRow, 56).Value = Me.txtservRep5.Value
    ws.Cells(iRow, 57).Value = Me.txtArrival5.Value
    ws.Cells(iRow, 58).Value = Me.txtDEPARTURE5.Value
    ws.Cells(iRow, 59).Value = Me.txtOdometerstart5.Value
    ws.Cells(iRow, 60).Value = Me.txtOdometerend5.Value

    ws.Cells(iRow, 61).Value = Me.txtDRSI6.Value
    ws.Cells(iRow, 62).Value = Me.txtCustomer6.Value
    ws.Cells(iRow, 63).Value = Me.txtlocation6.Value
    ws.Cells(iRow, 64).Value = Me.txtJobDescript6.Value
    ws.Cells(iRow, 65).Value = Me.txtservRep6.Value
    ws.Cells(iRow, 66).Value = Me.txtArrival6.Value
    ws.Cells(iRow, 67).Value = Me.txtDEPARTURE6.Value
    ws.Cells(iRow, 68).Value = Me.txtOdometerstart6.Value
    ws.Cells(iRow, 69).Value = Me.txtOdometerend6.Value
    ''clear the data
    Me.txttripticketno.Value = ""
    Me.txttech1.Value = ""
    Me.txttech2.Value = ""
    Me.txtPlate.Value = ""
    Me.TxtDateOut.Value = ""
    Me.TxtDateIn.Value = ""
    Me.txtTimeOut.Value = ""
    Me.txtTimein.Value = ""
    Me.txtKMout.Value = ""
    Me.txtkmIn.Value = ""
    Me.txtRugsQty.Value = ""
    Me.txtSoapQty.Value = ""
    Me.txtfuelQty.Value = ""
    Me.txtPailOutQty.Value = ""
    Me.txtPailInQty.Value = ""
    Me.txtDRSI1.Value = ""
    Me.txtCustomer1.Value = ""
    Me.txtlocation1.Value = ""
    Me.txtJobDescript1.Value = ""
    Me.txtServRep1.Value = ""
    Me.txtArrival1.Value = ""
    Me.txtDEPARTURE1.Value = ""
    Me.txtOdometerstart1.Value = ""
    Me.txtOdometerend1.Value = ""

    Me.txtDRSI2.Value = ""
    Me.txtCustomer2.Value = ""
    Me.txtlocation2.Value = ""
    Me.txtJobDescript2.Value = ""
    Me.txtServRep2.Value = ""
    Me.txtArrival2.Value = ""
    Me.txtDEPARTURE2.Value = ""
    Me.txtOdometerstart2.Value = ""
    Me.txtOdometerend2.Value = ""

    Me.txtDRSI3.Value = ""
    Me.txtCustomer3.Value = ""
    Me.txtlocation3.Value = ""
    Me.txtJobDescript3.Value = ""
    Me.txtservRep3.Value = ""
    Me.txtArrival3.Value = ""
    Me.txtDEPARTURE3.Value = ""
    Me.txtOdometerstart3.Value = ""
    Me.txtOdometerend3.Value = ""

    Me.txtDRSI4.Value = ""
    Me.txtCustomer4.Value = ""
    Me.txtlocation4.Value = ""
    Me.txtJobDescript4.Value = ""
    Me.txtservRep4.Value = ""
    Me.txtArrival4.Value = ""
    Me.txtDEPARTURE4.Value = ""
    Me.txtOdometerstart4.Value = ""
    Me.txtOdometerend4.Value = ""

    Me.txtDRSI5.Value = ""
    Me.txtCustomer5.Value = ""
    Me.txtlocation5.Value = ""
    Me.txtJobDescript5.Value = ""
    Me.txtservRep5.Value = ""
    Me.txtArrival5.Value = ""
    Me.txtDEPARTURE5.Value = ""
    Me.txtOdometerstart5.Value = ""
    Me.txtOdometerend5.Value = ""

    Me.txtDRSI6.Value = ""
    Me.txtCustomer6.Value = ""
    Me.txtlocation6.Value = ""
    Me.txtJobDescript6.Value = ""
    Me.txtservRep6.Value = ""
    Me.txtArrival6.Value = ""
    Me.txtDEPARTURE6.Value = ""
    Me.txtOdometerstart6.Value = ""
    Me.txtOdometerend6.Value = ""

    Me.txttripticketno.SetFocus
    End Sub

    Private Sub scbTripticket_Change()
    Dim sPrompt As String
    Dim sTitle As String
    Dim lResp As Long

    sPrompt = "Save Changes?"
    sTitle = "Record Has Changed"

    If Me.IsDirty Then
    lResp = MsgBox(sPrompt, vbYesNo, sTitle)
    If lResp = vbYes Then
    SaveRecord CLng(Me.scbTripticket.Value > mlLastScrollValue)
    End If
    End If

    PopulateRecord

    mlLastScrollValue = Me.scbTripticket.Value

    End Sub

    Private Sub UserForm_Initialize()

    Dim ctlInfo As Control
    Dim clsEvents As CControlEvents

    ''A module level collection so the classes don't
    ''lose scope
    Set mcControls = New Collection

    ''Loop through the controls on the form
    For Each ctlInfo In Me.Controls
    ''Controls with a numeric tag are data entry controls
    ''and that's what we want
    If IsNumeric(ctlInfo.Tag) Then
    'Create a new class
    Set clsEvents = New CControlEvents
    'Determine the type of control, set the public
    'withevents class variable to the control, and
    'add the class to the collection so it won't go
    'out of scope while the form is shown.
    Select Case TypeName(ctlInfo)
    Case "TextBox"
    Set clsEvents.gTextBox = ctlInfo
    mcControls.Add clsEvents, CStr(ctlInfo.Tag)
    Case "ComboBox"
    Set clsEvents.gCombo = ctlInfo
    mcControls.Add clsEvents, CStr(ctlInfo.Tag)
    End Select
    End If
    Next ctlInfo

    'Start at the first record
    'Me.TripticketData.Value = Me.TripticketData.Min

    End Sub

    Private Sub PopulateRecord()

    Dim lRow As Long
    Dim ctlInfo As Control

    'Store row of current record
    lRow = Me.scbTripticket.Value

    With TripticketData.Range("A2")
    'Loop through controls
    For Each ctlInfo In Me.Controls
    'If the Tag is numeric, it is a data entry
    'control.
    If IsNumeric(ctlInfo.Tag) Then
    'Get the data from the worksheet
    ctlInfo.Text = .Offset(lRow, ctlInfo.Tag).Value
    End If
    Next ctlInfo
    End With

    'Mark this record as clean
    Me.IsDirty = False

    End Sub
    Private Sub SaveRecord(Optional ByVal lOffset As Long = 0)

    Dim lRow As Long
    Dim ctlInfo As Control

    'Store row of current record
    lRow = Me.scbTripticket.Value + lOffset

    With TripticketData.Range("A1")
    'Loop through controls
    For Each ctlInfo In Me.Controls
    'Limit to data entry controls
    If IsNumeric(ctlInfo.Tag) Then
    'Write the values to cells
    .Offset(lRow, ctlInfo.Tag).Value = ctlInfo.Text
    End If
    Next ctlInfo
    End With

    'Re-initialize the scrollbar settings
    DefineScroll

    'Mark this record as clean
    Me.IsDirty = False

    End Sub

    Private Sub DefineScroll()

    Dim rBottom As Range
    Dim lRecordCnt As Long

    With TripticketData
    'Find the last used cell in column A
    Set rBottom = .Range("A" & .Rows.Count).End(xlUp)

    'If the database is empty
    If rBottom.Row = 1 Then
    lRecordCnt = 1 'set for one record - a new one
    Else
    'Set for all records plus a new one
    lRecordCnt = .Range("A2", rBottom).Rows.Count + 1
    End If
    End With

    'Set the min and max
    Me.scbTripticket.Min = 1: Me.scbTripticket.Max = lRecordCnt

    End Sub

    Property Get IsDirty() As Boolean

    IsDirty = mbIsDirty

    End Property

    Property Let IsDirty(bDirty As Boolean)

    mbIsDirty = bDirty
    Me.cmdSave.Enabled = bDirty

    End Property

    Private Sub UserForm_Click()

    End Sub

Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.