userform - how to lookup and write data to a specific row in a worksheet based on unique ID of first cell in row

[Pyros]

The question(s) is:

1. How do I get a userform to write data to a specific worksheet row based on a uniqueID in the first cell of that row (this id is created automatically in an earlier part of the process)?
2. How do I populate the content of a userform with data from a worksheet (located by entering the uniqueID) and then allow users to edit it?

I’ve created a multipage userform, with the option to submit data at the bottom of each page.
On clicking submit on the first page, a uniqueID is created for this record and this id along with the rest of the data on this page is written to a worksheet

What I’m having trouble doing is writing data to the same worksheet row at a later stage in the multipage userform, and looking up the data ta later date and enable editing

The code for the first page of the userform Submit Command button is below:

Private Sub btnSetupSubmit_Click()
'Check for all required entries
If tboSetupUserName = "" Or cboSetupBrand.Value = "" _
Or tboSetupDate = "" Or cboSetupPageType.Value = "" Or tboSetupPageTitle = "" _
Or tboSetupPageURL = "" Or tboSetupObjective = "" Or tboSetupMethod = "" Then
'Notify user if entries are missing
MsgBox "You must complete all fields on this page", vbCritical, "hmmm, want to try that again?"
Me.tboSetupUserName.SetFocus
Exit Sub
Else

'rest of code

'write this page data to worksheet
Dim LastRow As Object
Set LastRow = Sheet1.Range("a104857").End(xlUp)

'generate and write UniqueID
LastRow.Offset(1, 0).Value = LastRow.Offset(0, 0).Value + 1
'write UniqueID to form
tboSetupUniqueID.Text = LastRow.Offset(1, 0).Value
'write rest of data to worksheet
LastRow.Offset(1, 1).Value = tboSetupUserName.Text
LastRow.Offset(1, 2).Value = cboSetupBrand.Text
LastRow.Offset(1, 3).Value = tboSetupDate.Text
LastRow.Offset(1, 4).Value = cboSetupPageType.Text
LastRow.Offset(1, 5).Value = tboSetupPageTitle.Text
LastRow.Offset(1, 6).Value = tboSetupPageURL.Text
LastRow.Offset(1, 7).Value = tboSetupObjective.Text
LastRow.Offset(1, 8).Value = tboSetupMethod.Text
'notification to user
MsgBox "Data written to Worksheet", vbInformation, "Congratulations!"

'write UniqueID to tboPreChangeUniqueID.Value
tboPreChangeUniqueID.Value = tboSetupUniqueID.Value

'lock data
tboSetupUserName.Locked = True
cboSetupBrand.Locked = True
tboSetupDate.Locked = True
cboSetupPageType.Locked = True
tboSetupPageTitle.Locked = True
tboSetupPageURL.Locked = True
tboSetupObjective.Locked = True
tboSetupMethod.Locked = True
tboPreChangeUniqueID.Locked = True

'make Pre-Change Data page accessible
MultiPage1.pagPreChangeData.Visible = True
'take user to Pre-Change Data page
MultiPage1.Value = 1

End If
End Sub


The second page in the userform is MultiPage1 and this also has text and combo boxes on it, and when users input data into these boxes I need it to appear on the same row as specified by the uniqueID (tboSetupUniqueID.Value)

Hope someone can help

Thanks,

Ben

 

[tlowry]

Here 's my suggestion for the code you want. I did very little testing with MultiPage. It's not clear to me why you would want to use a MultiPage presentation. However, I think this code will still work.

tlowry

'==========================================================
'==========================================================
'==========================================================
'==========================================================
'   Instructions:
'       1. Create a code module
'       2. Copy this code to the module
'       3. Change [B]Public Const DATASHEET = "Data" [/B]to the correct sheet name
'       4. Change[B] Public Const IDCOL = 1[/B] to the correct column (UniqueID column)
'       5. Change  With UserForm1 to your user form name
'       6. Have the user form with data controls named:
'              "tboSetupUserName", "cboSetupBrand", "tboSetupDate", "cboSetupPageType", _
'                "tboSetupPageTitle", "tboSetupPageURL", "tboSetupObjective", "tboSetupMethod"
'            and CommandButtons named:
'               "cbFind", "cbClear", "cbSave" and "cbNew"
'       7. Copy the following CommandButton Code to the UserForm code module (remove comment marks)
'
''==========================================================
'' Start of Userform Code vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
''   Requires a Userform1 with four Command Buttons
''       which call an individual TakeAction ie:
''==========================================================
'Private Sub cbFind_Click()
'    TakeAction actFind
'End Sub
'
'Private Sub cbClear_Click()
'    TakeAction actClear
'End Sub
'
'Private Sub cbSave_Click()
'    TakeAction actSave
'End Sub
'
'Private Sub cbNew_Click()
'    TakeAction actNew
'End Sub
'' End of Userform Code ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
''==========================================================
''==========================================================

Option Explicit
'==========================================================[B]
Public Const DATASHEET = "Data"[/B] ' sheet with data[B]
Public Const IDCOL = 1 [/B]         ' number of the column with unique User ID
'==========================================================
Enum DataActions        ' Actions to be taken
    actFind             ' Find current record
    actClear            ' Clear input fields
    actSave             ' Save displayed record
    actNew              ' Create a new record
End Enum
'==========================================================
Sub TakeAction(act As DataActions)
    With UserForm1
        Dim tboarray
        tboarray = Array("tboSetupUserName", "cboSetupBrand", "tboSetupDate", _
                            "cboSetupPageType", "tboSetupPageTitle", _
                            "tboSetupPageURL", "tboSetupObjective", "tboSetupMethod")
        Dim irow As Long, ictrl, iNextrow
        Dim uName As String
        uName = CStr(Trim(.Controls("tboSetupUserName")))  'Get uID from user form
        irow = GetRowNumber(uName)                         'Get uID row number
        Select Case act
            Case DataActions.actFind    ' finds a specific uID and displays data
                If irow = -1 Then
                    MsgBox "Could not find data for: " & uName
                Else
                    For ictrl = 1 To UBound(tboarray)
                        .Controls(tboarray(ictrl)).Value = _
                                Sheets(DATASHEET).Rows(irow).Cells(1, ictrl + 1)
                    Next ictrl
                End If
            Case DataActions.actClear   ' clears controls on UserForm
                For ictrl = 0 To UBound(tboarray)
                    .Controls(tboarray(ictrl)).Value = ""
                Next ictrl
            Case DataActions.actSave    ' saves to an existing record
                    If irow = -1 Then
                        MsgBox "Could not save data for: " & uName
                    Else
                        For ictrl = 1 To UBound(tboarray)
                            Sheets(DATASHEET).Rows(irow).Cells(1, ictrl + 1) = _
                                    .Controls(tboarray(ictrl)).Value
                        Next ictrl
                    End If
            Case DataActions.actNew     ' saves to a new record
                If irow <> -1 Then
                    MsgBox uName & " already exists.", vbCritical
                Else
                    iNextrow = Sheets(DATASHEET).UsedRange.Rows.Count + 1
                    Sheets(DATASHEET).Cells(iNextrow, IDCOL) = uName
                    TakeAction actSave
                End If
        End Select
    End With
End Sub
'==========================================================
Function GetRowNumber(sIDin) As Long ' gets row of uID or -1 if non existant
    Dim cCell
    GetRowNumber = -1
    With Sheets(DATASHEET)
        For Each cCell In Intersect(.UsedRange, .Columns(IDCOL)).Cells
            If CStr(cCell) = CStr(sIDin) Then
                GetRowNumber = cCell.Row
                Exit Function
            End If
        Next cCell
    End With
End Function
'==========================================================
'==========================================================
'==========================================================
'==========================================================