Search code examples
excelvbalistuserform

Update list with userform based on multiple criteria in VBA

I have a list with Name, Phone number, City and Dinner.

When the user fills out the user form they type in the abovementioned inputs.

The code updates the list if they fill in the same Name so the list does not append another row. I tried to edit the code such that it take into account Phone number too, but nothing changes.

However, how can I make the list add a new row if the user adds in the same name but different number?

Private Sub OKButton_Click()

Dim emptyRow As Long

'Make Sheet1 active
Sheet1.Activate

'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

' try to retrieve the Name
Dim rngIdList As Range, rngId As Range
Dim phoneIdList As Range, phoneId As Range

Set rngIdList = ActiveSheet.Range([a2], [a2].End(xlDown))
Set phoneIdList = ActiveSheet.Range([b2], [b2].End(xlDown))

Set rngId = rngIdList.Find(Me.NameTextBox.Value, LookIn:=xlValues)
Set phoneId = phoneIdList.Find(Me.PhoneTextBox.Value, LookIn:=xlValues)

If rngId Is Nothing And phoneId Is Nothing Then
    ' if Name is not found, append new one to the end of the table
    With rngIdList And phoneIdList
        Set rngId = .Offset(.Rows.Count, 0).Resize(1, 1)
        Set phoneId = .Offset(.Rows.Count, 0).Resize(1, 1)
    End With
End If

' update excel record
rngId.Offset(0, 0).Value = Me.NameTextBox.Value
rngId.Offset(0, 1).Value = Me.PhoneTextBox.Value
rngId.Offset(0, 2).Value = Me.CityListBox.Value
rngId.Offset(0, 3).Value = Me.DinnerComboBox.Value

phoneId.Offset(0, 0).Value = Me.NameTextBox.Value
phoneId.Offset(0, 1).Value = Me.PhoneTextBox.Value
phoneId.Offset(0, 2).Value = Me.CityListBox.Value
phoneId.Offset(0, 3).Value = Me.DinnerComboBox.Value

Expected output: Here you can see that Jake adds his name multiple times with different phone numbers, but it doesn't get overwritten (as intended). However, if he adds number 888 again with different Dinner, it will get overwritten with Italian. If he adds number 222, then another row will be added to the list.

enter image description here

Solution

  • Try this. It's untested so let me know how you get on. I've added various explanatory comments.

    Private Sub OKButton_Click()

Dim emptyRow As Long, s As String, bFound As Boolean

Sheet1.Activate
emptyRow = Range("A" & Rows.Count).End(xlUp).Row

Dim rngIdList As Range, rngId As Range

Set rngIdList = Range("A2:A" & emptyRow)
Set rngId = rngIdList.Find(Me.NameTextBox.Value, LookIn:=xlValues)

If rngId Is Nothing Then 'NAME NOT FOUND SO ADD NEW RECORD
    With Range("A" & emptyRow + 1)
        .Value = Me.NameTextBox.Value
        .Offset(0, 1).Value = Me.PhoneTextBox.Value
        .Offset(0, 2).Value = Me.CityListBox.Value
        .Offset(0, 3).Value = Me.DinnerComboBox.Value
    End With
Else 'NAME FOUND
    s = rngId.Address
    Do
        If rngId.Offset(, 1).Value = Me.PhoneTextBox.Value Then 'PHONE NUMBER FOUND FOR SAME NAME SO UPDATE RECORD
            With rngId
                .Offset(0, 2).Value = Me.CityListBox.Value
                .Offset(0, 3).Value = Me.DinnerComboBox.Value
            End With
            bFound = True
            Exit Do 'NO NEED TO KEEP LOOKING
        End If
        Set rngId = rngIdList.FindNext(rngId)
    Loop While rngId.Address <> s 'KEEP LOOKING UNTIL BACK TO FIRST FOUND VALUE
    If Not bFound Then 'IF NAME/PHONE COMBO HAS NOT BEEN FOUND
        With Range("A" & emptyRow + 1)
            .Value = Me.NameTextBox.Value
            .Offset(0, 1).Value = Me.PhoneTextBox.Value
            .Offset(0, 2).Value = Me.CityListBox.Value
            .Offset(0, 3).Value = Me.DinnerComboBox.Value
        End With
    End If
End If

End Sub