How can I edit/update an existing record in my database using a listbox in Excel userform?

Question

I am creating an Excel userform in which users can add, search, and update records. I was able to create a button command that searches the database (a single sheet in my workbook) and populates a listbox with the search results. Because my database has more than 10 columns which I wanted to be visible in the listbox, I used an array to populate the listbox rather than AddItem which limited me to 10 or fewer columns. (the search code is below)

    Private Sub Search_Click()

    ''''''''''''Validation
    If Trim(SearchTextBox.Value) = "" And Me.Visible Then
    MsgBox "Please enter a search value.", vbCritical, "Error"
    Exit Sub
    End If

ReDim arrs(0 To 17, 1 To 1)

With Worksheets("Sheet1")
ListBox.Clear
ListBox.ColumnCount = 18
ListBox.ColumnHeads = True
ListBox.Font.Size = 10
ListBox.ColumnWidths = "80,80,150,130,90,90,80,80,80,80,80,60,70,150,150,150,150,180"
    
    If .FilterMode Then .ShowAllData
    Set k = .Range("K2:K" & Cells(Rows.Count, "K").End(xlUp).Row).Find(What:="*" & SearchTextBox.Text & "*", LookIn:=xlValues, lookat:=xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            M = M + 1
            ReDim Preserve arrs(0 To 17, 1 To M)
            For j = 0 To 17
                arrs(j, M) = .Cells(k.Row, j + 1).Value
            Next j
            Set k = .Range("K2:K" & Cells(Rows.Count, "K").End(xlUp).Row).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox.Column = arrs
        
        Else
            
        ' If you get here, no matches were found
        MsgBox "No matches were found based on the search criteria.", vbInformation

    End If
End With
End Sub

I also added code so that when I double click on a record in the listbox, it populates the corresponding textbox in the userform.

Private Sub ListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

        TextBox1.Text = ListBox.Column(0)
        If TextBox1.Text = ListBox.Column(0) Then
        TextBox1.Text = ListBox.Column(0)
        TextBox2.Text = ListBox.Column(1)
        TextBox3.Text = ListBox.Column(2)
        TextBox4.Text = ListBox.Column(3)
        TextBox5.Text = ListBox.Column(4)
        TextBox6.Text = ListBox.Column(5)
        TextBox7.Text = ListBox.Column(6)
        TextBox8.Text = ListBox.Column(7)
        TextBox9.Text = ListBox.Column(8)
        TextBox10.Text = ListBox.Column(9)
        TextBox11.Text = ListBox.Column(10)
        TextBox12.Text = ListBox.Column(11)
        TextBox13.Text = ListBox.Column(12)
        TextBox14.Text = ListBox.Column(13)
        TextBox15.Text = ListBox.Column(14)
        TextBox16.Text = ListBox.Column(15)
        TextBox17.Text = ListBox.Column(16)
        TextBox18.Text = ListBox.Column(17)
        
        End If

End Sub

After double clicking on a search result from the listbox, I want users to be able to edit any information in those textboxes and click a command button to update that entry/record in the database itself. However, I am having some problems with creating this function. I used the following code, and although it doesn't return an error message, it doesn't change the entry in the database.

    Dim X As Long
    Dim Y As Long
    X = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
        
    
        For Y = 2 To X
        If Sheets("Sheet1").Cells(Y, 11).Value = SearchTextBox.Text Then
        
        Sheets("Sheet1").Cells(Y, 1).Value = TextBox1
        Sheets("Sheet1").Cells(Y, 2).Value = TextBox2
        Sheets("Sheet1").Cells(Y, 3).Value = TextBox3
        Sheets("Sheet1").Cells(Y, 4).Value = TextBox4
        Sheets("Sheet1").Cells(Y, 5).Value = TextBox5
        Sheets("Sheet1").Cells(Y, 6).Value = TextBox6
        Sheets("Sheet1").Cells(Y, 7).Value = TextBox7
        Sheets("Sheet1").Cells(Y, 8).Value = TextBox8
        Sheets("Sheet1").Cells(Y, 9).Value = TextBox9
        Sheets("Sheet1").Cells(Y, 10).Value = TextBox10
        Sheets("Sheet1").Cells(Y, 11).Value = TextBox11
        Sheets("Sheet1").Cells(Y, 12).Value = TextBox12
        Sheets("Sheet1").Cells(Y, 13).Value = TextBox13
        Sheets("Sheet1").Cells(Y, 14).Value = TextBox14
        Sheets("Sheet1").Cells(Y, 15).Value = TextBox15
        Sheets("Sheet1").Cells(Y, 16).Value = TextBox16
        Sheets("Sheet1").Cells(Y, 17).Value = TextBox17
        Sheets("Sheet1").Cells(Y, 18).Value = TextBox18
      
      End If
      Next Y

Additionally, the term that I am searching with is not unique, so there are multiple records/rows in the database with the same search term. How can I create this code in a way that I when I click on the update button, information from the userform (which has been populated by doubleclicking the record in the listbox) is updated in the excel sheet but not for all records with the same search term?

Thank you so much for any help!

Answer 1

Add a Label to your UserForm to hold the row number from where the text box values came. Use the first column (width zero so hidden) of the listbox to hold the row number of the filtered rows. Set the label to column 0 of the double clicked row.

Option Explicit

Private Sub Update_Click()
    Dim r As Long, n As Long
    ' record showing
    r = Val(Label1.Caption)
    If r < 1 Then
        Exit Sub
    End If
    
    With Sheets("Sheet1")
        For n = 1 To 18
           .Cells(r, n).Value2 = Me.Controls("TextBox" & n)
        Next
    End With   
End Sub

Private Sub ListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim n As Long
    With ListBox
        For n = 1 To ListBox.ColumnCount - 1
            Debug.Print n, .Column(n)
            Me.Controls("TextBox" & n).Text = .Column(n)
        Next
        Label1.Caption = .Column(0)
    End With
End Sub

Private Sub Search_Click()
    Const COLS = 18

    Dim s
    s = Trim(SearchTextBox.Value)
    If s = "" And Me.Visible Then
        MsgBox "Please enter a search value.", vbCritical, "Error"
        Exit Sub
    Else
        s = "*" & s & "*"
    End If

    Dim rngFnd As Range, rngSearch As Range, first As String
    Dim arr, lastrow As Long, i As Long, j As Long
    
    ' search sheet
    With Worksheets("Sheet1")
        If .FilterMode Then .ShowAllData
        lastrow = .Cells(.Rows.Count, "K").End(xlUp).Row
        Set rngSearch = .Range("K1:K" & lastrow)
        
        i = WorksheetFunction.CountIf(rngSearch, s)
        If i > 0 Then
            ReDim arr(0 To COLS, 1 To i)
            Set rngFnd = rngSearch.Find(What:=s, LookIn:=xlValues, lookat:=xlWhole)
                   
            If Not rngFnd Is Nothing Then
                i = 0
                first = rngFnd.Address
                Do
                    i = i + 1
                    arr(0, i) = rngFnd.Row
                    For j = 1 To COLS
                        arr(j, i) = .Cells(rngFnd.Row, j).Value
                    Next j
                    Set rngFnd = rngSearch.FindNext(rngFnd)
                Loop While rngFnd.Address <> first
            End If
        Else
            'If you get here, no matches were found
            MsgBox "No matches were found based on the search criteria. " & s, vbExclamation
            Exit Sub
        End If
    End With
    ' format listbox
    With ListBox
        .Clear
        .ColumnCount = COLS + 1
        .ColumnHeads = True
        .Font.Size = 10
        .ColumnWidths = "0,80,80,150,130,90,90,80,80,80,80,80,60,70,150,150,150,150,180"
        .Column = arr
    End With
End Sub