Userform, Update Rows in Database based on Combobox selected item. Problem with updating.

J

jmarriott

New Member
Joined
Aug 1, 2013
Messages
6
I have now been going nuts for two days trying to get this to work-and its probably a simple fix
---Please help I am at my wits end, .

I have created a userform for a database of contacts, I have a combobox on the userform that pulls a company name from column A based on that selection a number of textboxes are populated with info from the related adjacent rows.
My issue is I would like to be able to edit the data in the textboxes and click a command button to update the related data.....I have got it to work for Column A only, the adjacent rows will not update with the changes.
Note:I cannot use the VLookup or Match to find the combobox value because the data in row A is not all unique (IE: multiple contacts from the same company = duplicate values in column A)

Here is the latest code I have been using, again rows in column A WILL change but the others revert back to the original state on command button click-- Please help.

Combobox name-Coname
Userform-Userform1
Worksheet-Metadata

'select value from Combo box​
Private Sub Coname_change()
Dim lngDataRow As Long
lngDataRow = UserForm1.Coname.ListIndex + 1
' populate textboxes​
Dim c As Range​
UserForm1.CompName.Value = Worksheets("Metadata").Range("A" & lngDataRow).Value
UserForm1.Contact.Value = Worksheets("Metadata").Range("J" & lngDataRow).Value
UserForm1.Phone.Value = Worksheets("Metadata").Range("C" & lngDataRow).Value
UserForm1.Fax.Value = Worksheets("Metadata").Range("D" & lngDataRow).Value
UserForm1.Email.Value = Worksheets("Metadata").Range("K" & lngDataRow).Value
UserForm1.Cellphone.Value = Worksheets("Metadata").Range("N" & lngDataRow).Value
UserForm1.Address.Value = Worksheets("Metadata").Range("E" & lngDataRow).Value
UserForm1.City.Value = Worksheets("Metadata").Range("H" & lngDataRow).Value
UserForm1.State.Value = Worksheets("Metadata").Range("I" & lngDataRow).Value
UserForm1.Zip.Value = Worksheets("Metadata").Range("G" & lngDataRow).Value
UserForm1.Scope.Value = CompName.Value & vbNewLine & Contact.Value & vbNewLine & Phone.Value & vbNewLine & Email.Value

Private Sub CBUpdate_Click()
'Update cells in workbook with changed values​
Worksheets("Metadata").Range("A" & Coname.ListIndex + 1).Value = Me.CompName.Value
' **********Above is the only one that works​
Worksheets("Metadata").Range("J" & Coname.ListIndex + 1).Value = Me.Contact.Value
Worksheets("Metadata").Range("C" & Coname.ListIndex + 1).Value = Me.Phone.Value


'Above and below, two different attempts

Worksheets("Metadata").Range("D" & Coname.ListIndex + 1).Value = Me("Fax").Value
Worksheets("Metadata").Range("K" & Coname.ListIndex + 1).Value = Me("Email").Value
Worksheets("Metadata").Range("N" & Coname.ListIndex + 1).Value = Me("Cellphone").Value
Worksheets("Metadata").Range("E" & Coname.ListIndex + 1).Value = Me("Address").Value
Worksheets("Metadata").Range("H" & Coname.ListIndex + 1).Value = Me("City").Value
Worksheets("Metadata").Range("I" & Coname.ListIndex + 1).Value = Me("State").Value
Worksheets("Metadata").Range("G" & Coname.ListIndex + 1).Value = Me("Zip").Value
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
Hi and welcome to the forum.

When posting code to the forum, surround your code with
Code: 
 tags. It makes reading your code much easier. See my signature block below.

You are probably using the [I]Coname.RowSource[/I] to populate the combobox. If yes, when you change any one value within the [I]RowSource [/I]range, the combobox immediately updates the list. That triggers the [I]Coname_Change[/I] event procedure and that repopulates the textboxes with the original values erasing all the changes the user inputted.

Try this. It doesn't update the textboxes unles it is when you make a [U]Selection[/U] from the [I]Coname[/I] combobox

[CODE][COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Coname_Change()
    
    [B][COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] ActiveControl [COLOR=darkblue]Is[/COLOR] Me.Coname [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR][/B]
    
    [COLOR=darkblue]Dim[/COLOR] lngDataRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    lngDataRow = UserForm1.Coname.ListIndex + 1
    [COLOR=green]' populate textboxes[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] c      [COLOR=darkblue]As[/COLOR] Range
    UserForm1.CompName.Value = Worksheets("Metadata").Range("A" & lngDataRow).Value
    UserForm1.Contact.Value = Worksheets("Metadata").Range("J" & lngDataRow).Value
    UserForm1.Phone.Value = Worksheets("Metadata").Range("C" & lngDataRow).Value
    UserForm1.Fax.Value = Worksheets("Metadata").Range("D" & lngDataRow).Value
    UserForm1.Email.Value = Worksheets("Metadata").Range("K" & lngDataRow).Value
    UserForm1.Cellphone.Value = Worksheets("Metadata").Range("N" & lngDataRow).Value
    UserForm1.Address.Value = Worksheets("Metadata").Range("E" & lngDataRow).Value
    UserForm1.City.Value = Worksheets("Metadata").Range("H" & lngDataRow).Value
    UserForm1.State.Value = Worksheets("Metadata").Range("I" & lngDataRow).Value
    UserForm1.Zip.Value = Worksheets("Metadata").Range("G" & lngDataRow).Value
    UserForm1.Scope.Value = CompName.Value & vbNewLine & Contact.Value & vbNewLine & Phone.Value & vbNewLine & Email.Value
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] CBUpdate_Click()
    
    [COLOR=green]'Update cells in workbook with changed values[/COLOR]
    Worksheets("Metadata").Range("A" & Coname.ListIndex + 1).Value = Me.CompName.Value
    Worksheets("Metadata").Range("J" & Coname.ListIndex + 1).Value = Me.Contact.Value
    Worksheets("Metadata").Range("C" & Coname.ListIndex + 1).Value = Me.Phone.Value
 
Last edited:
Upvote 0
Thank you! Updating is now working! I figured it would be something easy!

but........now I am getting a 1004 message if any of the textboxes are empty and I update...if the column A box is empty it does not give an error just the others.

Code: 
 Worksheets("Metadata").Range("J" & Coname.ListIndex + 1).Value = Me.Contact.Value
     Worksheets("Metadata").Range("C" & Coname.ListIndex + 1).Value = Me.Phone.Value
     Worksheets("Metadata").Range("D" & Coname.ListIndex + 1).Value = Me.Fax.Value
     Worksheets("Metadata").Range("K" & Coname.ListIndex + 1).Value = Me.Email.Value
     Worksheets("Metadata").Range("N" & Coname.ListIndex + 1).Value = Me.Cellphone.Value
     Worksheets("Metadata").Range("E" & Coname.ListIndex + 1).Value = Me.Address.Value
     Worksheets("Metadata").Range("H" & Coname.ListIndex + 1).Value = Me.City.Value
     Worksheets("Metadata").Range("I" & Coname.ListIndex + 1).Value = Me.State.Value
     Worksheets("Metadata").Range("G" & Coname.ListIndex + 1).Value = Me.Zip.Value

This may also be causing my other issue...or i may have a reference wrong. I have code that is meant to delete a row on the sheet if there is No entry in row "A" (based on combobox value), after the update or row deletion the sheet should re-sort A-Z based on column "A".
What do you think is the issue?

Code: 
If Worksheets("Metadata").Range("A" & Coname.ListIndex + 1).Value = "" Then
        Response = MsgBox("No Company Name - Delete this Contact?", vbYesNo + vbQuestion)
          End If
     If Response = vbYes Then
        Worksheets("Metadata").Range(Coname.ListIndex + 1).EntireRow.Delete
          Else
           Exit Sub
             End If
      Application.ScreenUpdating = True
           
           
Worksheets("Metadata").AutoFilter.Sort.SortFields.Clear
Worksheets("Metadata").AutoFilter.Sort.SortFields.Add Key:= _
         Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
         xlSortNormal
       With Worksheets("Metadata").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
            End With
                                                        
End Sub
 
Upvote 0
Okay, I added the no no line of error handling--

"On Error Resume Next"

and the delete row and sort subs work, if I get rid of the "On Error Resume Next" all of the errors are there...........
 
Upvote 0
Okay after further testing....it is NOT working, there is an object error on the first line :

Code: 
Worksheets("Metadata").Range("A" & Coname.ListIndex + 1).Value =Me.CompName.Value

When I have the "on error resume next" it appears to work if the data is altered in one of the boxes BUT if I remove the data in the textbox related to column "A" (which is suppose to prompt the delete Row VBBOX) all it is doing is re-sort and moving the data to the bottom of the workbook (there is no longer data to sort in row A but the adjacent data rows still contain data--- it is not clearing them.
Any Ideas?


COMMAND WITH UPDATE COMMAND BUTTON

Code: 
Private Sub CBUpdate_Click()
Dim Response As VbMsgBoxResult
On Error Resume Next
     Application.ScreenUpdating = True
     Worksheets("Metadata").Range("A" & Coname.ListIndex + 1).Value = Me.CompName.Value
     Worksheets("Metadata").Range("J" & Coname.ListIndex + 1).Value = Me.Contact.Value
     Worksheets("Metadata").Range("C" & Coname.ListIndex + 1).Value = Me.Phone.Value
            
     Worksheets("Metadata").Range("D" & Coname.ListIndex + 1).Value = Me.Fax.Value
     Worksheets("Metadata").Range("K" & Coname.ListIndex + 1).Value = Me.Email.Value
     Worksheets("Metadata").Range("N" & Coname.ListIndex + 1).Value = Me.Cellphone.Value
     Worksheets("Metadata").Range("E" & Coname.ListIndex + 1).Value = Me.Address.Value
     Worksheets("Metadata").Range("H" & Coname.ListIndex + 1).Value = Me.City.Value
     Worksheets("Metadata").Range("I" & Coname.ListIndex + 1).Value = Me.State.Value
     Worksheets("Metadata").Range("G" & Coname.ListIndex + 1).Value = Me.Zip.Value
     
     
     If Worksheets("Metadata").Range("A" & Coname.ListIndex + 1).Value = "" Then
        Response = MsgBox("No Company Name - Delete this Contact?", vbYesNo + vbQuestion)
          End If
     If Response = vbYes Then
        Worksheets("Metadata").Range(Coname.ListIndex + 1).Rows.Select
    Selection.Delete Shift:=xlUp
          Else
           Exit Sub
             End If
           
           
Worksheets("Metadata").AutoFilter.Sort.SortFields.Clear
Worksheets("Metadata").AutoFilter.Sort.SortFields.Add Key:= _
         Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
         xlSortNormal
       With Worksheets("Metadata").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
            End With
       Call UserForm_Initialize
End Sub

COMMAND WITH DELETE CONTACT COMMAND BUTTON

Code: 
Private Sub DeleteContact_Click()
Dim Response As VbMsgBoxResult

  Application.ScreenUpdating = True
     
        
     
    
     Worksheets("Metadata").Range("A" & Coname.ListIndex + 1).Value = ""
     Worksheets("Metadata").Range("J" & Coname.ListIndex + 1).Value = ""
     Worksheets("Metadata").Range("C" & Coname.ListIndex + 1).Value = ""
            
     Worksheets("Metadata").Range("D" & Coname.ListIndex + 1).Value = ""
     Worksheets("Metadata").Range("K" & Coname.ListIndex + 1).Value = ""
     Worksheets("Metadata").Range("N" & Coname.ListIndex + 1).Value = ""
     Worksheets("Metadata").Range("E" & Coname.ListIndex + 1).Value = ""
     Worksheets("Metadata").Range("H" & Coname.ListIndex + 1).Value = ""
     Worksheets("Metadata").Range("I" & Coname.ListIndex + 1).Value = ""
     Worksheets("Metadata").Range("G" & Coname.ListIndex + 1).Value = ""
      
         
           
           
Worksheets("Metadata").AutoFilter.Sort.SortFields.Clear
Worksheets("Metadata").AutoFilter.Sort.SortFields.Add Key:= _
         Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
         xlSortNormal
       With Worksheets("Metadata").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
            End With
    
       
End Sub
 
Upvote 0
jmarriott said:
Anybody have any Ideas???
Click to expand...

Maybe this approach will work for you.
Backup your workbook & then replace your forms code with following:

Code: 
Dim Metadata As Worksheet
Dim ComBxArr As Variant
Dim RangeArr As Variant
Dim lngDataRow As Long
Private Sub DeleteContact_Click()
    Dim Response As Variant
    Dim i As Integer
    Response = MsgBox(CompName.Text & Chr(10) & _
                      "Are You Sure That You Want To Delete Company?", 36, "Delete Record")
    If Response = 7 Then Exit Sub
    Metadata.Cells(lngDataRow, 1).EntireRow.Delete
    'update combobox list
    i = lngDataRow
    Call UserForm_Initialize
    Me.Coname.ListIndex = i - 1
End Sub

Private Sub Coname_Change()
    Dim i As Integer
    
    lngDataRow = Me.Coname.ListIndex + 1
    ' populate textboxes
    'on Error required when record deleted & combobox updates
    On Error Resume Next
    For i = LBound(ComBxArr) To UBound(ComBxArr)
        Me.Controls(ComBxArr(i)).Value = Metadata.Cells(lngDataRow, RangeArr(i)).Value
    Next i
    On Error GoTo 0
    Me.Scope.Value = CompName.Value & vbNewLine & Contact.Value & vbNewLine & Phone.Value & vbNewLine & Email.Value
End Sub

Private Sub CBUpdate_Click()
    Dim i As Integer
    'Update cells in workbook with changed values
    For i = LBound(ComBxArr) To UBound(ComBxArr)
        Metadata.Cells(lngDataRow, RangeArr(i)).Value = Me.Controls(ComBxArr(i)).Value
    Next i
    
    Me.Scope.Value = CompName.Value & vbNewLine & Contact.Value & vbNewLine & Phone.Value & vbNewLine & Email.Value
    
    'update combobox list
    i = lngDataRow
    Call UserForm_Initialize
    Me.Coname.ListIndex = i - 1
End Sub

Private Sub UserForm_Initialize()
    Dim CompanyNames As Variant
    Set Metadata = Worksheets("Metadata")
    ComBxArr = Array("CompName", "Contact", "Phone", "Fax", "Email", "Cellphone", "Address", "City", "State", "Zip")
    RangeArr = Array(1, 10, 3, 4, 11, 14, 5, 8, 9, 7)
    With Metadata
        .Unprotect Password:=""
        CompanyNames = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)).Value
    End With
    With Me.Coname
        .RowSource = ""
        .Clear
        .List = CompanyNames
    End With
End Sub

NOTE: the variables sitting at TOP of procedures - it is important that these sit at the TOP of your forms code module.

Code not tested & you will need to adjust it as required but hopefully, this approach may give you some ideas to develop your project.

Hope Helpful

Dave
 
Upvote 0
dmt32 Thank you very much for your reply and assistance!

I tried the code you provided, and it did work other than updating and resorting the worksheet data. I think i have my original code working, I replaced my delete contact code with this.
It is now deleting and resorting the data. I need to continue testing and will post if I run into any other issues I cannot figure out. Again thank you for your time and response.

Code: 
Private Sub DeleteContact_Click()
    Dim Response As VbMsgBoxResult
    Dim x As Long
    ' delete contact and row of data

    x = Coname.ListIndex + 1

    Application.ScreenUpdating = True
    Worksheets("Metadata").Range("A" & x).Value = ""
    Worksheets("Metadata").Range("J" & x).Value = ""
    Worksheets("Metadata").Range("C" & x).Value = ""

    Worksheets("Metadata").Range("D" & x).Value = ""
    Worksheets("Metadata").Range("K" & x).Value = ""
    Worksheets("Metadata").Range("N" & x).Value = ""
    Worksheets("Metadata").Range("E" & x).Value = ""
    Worksheets("Metadata").Range("H" & x).Value = ""
    Worksheets("Metadata").Range("I" & x).Value = ""
    Worksheets("Metadata").Range("G" & x).Value = ""

    ' confirmation pop up window
    If Worksheets("Metadata").Range("A" & x).Value = "" Then
        Response = MsgBox("No Company Name - Delete this Contact?", vbYesNo + vbQuestion)
    End If
    If Response = vbYes Then
        Worksheets("Metadata").Rows(x).Select
        Selection.Delete Shift:=xlUp
    Else
        Exit Sub
    End If

    're-sort workbook alphabetically

    Worksheets("Metadata").AutoFilter.Sort.SortFields.Clear
    Worksheets("Metadata").AutoFilter.Sort.SortFields.Add Key:= _
            Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
    With Worksheets("Metadata").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Call UserForm_Initialize

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Excel VBA- Viewing and Updating existing worksheet data with Excel UserForm with Dependent Comboboxes
Replies
2
Views
841
charliechaz
C
I
  • Question
Move existing row of value to another selected row
Replies
1
Views
134
ipbr21054
I
P
  • Question
Userform Listbox Edit Rows Within Sheet
Replies
1
Views
440
pure vito
P
A
  • Question
expand code to search on userform more than column by selection from combobox
Replies
1
Views
495
abdelfattah
A
I
  • Solved
Textbox details should be removed if combobox selection is overwritten
Replies
7
Views
418
Akuini
Akuini

Forum statistics

Threads
1,215,059
Messages
6,122,918
Members
449,093
Latest member
dbomb1414

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