If value isnt in userform drop down list then allow user to add it

[ipbr21054]

I have a userform which in ComboBox1 has a list of vehicles.
Sometimes when the user wants to make a selection the vehicle in question isnt there.
he then has a long winded workaround.
Close userform, open worksheet, add vehicle to table.
Start all over again.

This post is to allow the user to add the vehicle without the need of all the work.
Not sure how it would work but if vehicle isnt present maybe open an input box.
Type vehicle in question.
Code saves new vehicle to worksheet table list.
User then selects vehicle in ComboBox1
Continues with entering his other values.

Some info for you.
Worksheet where userform is located is called QUOTES
Userform is called QUOTES FORM
Vehicle drop down list is in Combo1
Worksheet where tables are is called INFO
Table location is column B
Table name is Table2

The new entry should be added to the last cell in the list.
Sort columb B from A-Z

 

[ipbr21054]

Here is a link for test file to download
Thanks.

DOWNLOAD HERE


This is how mine works so lets assume the car isnt present in the table.

Go to sheets QUOTES
Select Open Form.
Complete all field BUT vehicle list just type FERRARI
Select SEND TO QUOTES DATABASE
Youre asked if you manually added a car to the vehicle list.
So select YES

The vehicle FERRARI is added to Table2 at Row 28 on sheets INFO
Its also sorted A-Z
You are then brought back t6o sheet DATABASE

 

[NoSparks]

OK, remove the RowSource from ComboBox1 properties
and try this to initialize the form

Private Sub UserForm_Initialize()
    '-------------------------------
    Me.StartUpPosition = 0
    Me.Top = Application.Top + 100  ' MARGIN FROM TOP OF SCREEN
    Me.Left = Application.Left + Application.Width - Me.Width - 250 ' LEFT / RIGHT OF SCREEN
   
    '-------------------------------
    TextBox6.Value = Format(Date, "dd/mm/yyyy")
    
    ' to populate vehical list combobox1
    With Me.ComboBox1
        .RowSource = ""
        .List = Sheets("INFO").ListObjects("Table2").DataBodyRange.Value
        .MatchRequired = False
    End With
End Sub

Add this event for the combobox

Private Sub ComboBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Dim response As Integer
    Dim oNewRow As ListRow

' if combo empty stop here
If Len(Me.ComboBox1.Value) = 0 Then Exit Sub

' is entry in drop down
If Not Me.ComboBox1.MatchFound Then
    ' ask if to add entry to list
    response = MsgBox("Entry is not in the drop down" & vbCrLf & _
                      "Do you want to add it ?", vbYesNo)
    
    If response = vbYes Then
        
        Application.EnableEvents = False
        ' add row to table
        With Sheets("INFO").ListObjects("Table2")
            Set oNewRow = .ListRows.Add
            ' put what was entered into list
            oNewRow.Range.Cells(1) = Me.ComboBox1.Value
        End With
        
        '** SORT A=Z HERE **
        With Sheets("INFO").ListObjects("Table2")
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=.ListColumns(1).Range, SortOn:=xlSortOnValues, _
                                    Order:=xlAscending, DataOption:=xlSortTextAsNumbers
            With .Sort
                .Header = xlYes
                .Apply
            End With
        End With
        
        ' assign the new list to combo
        With Me.ComboBox1
            ' to clear combo or not ??
            .Value = ""    ' comment out to already have in combo
            ' maintain focus
            Cancel = True
            ' reload drop down
            .List = Sheets("INFO").ListObjects("Table2").DataBodyRange.Value
            .DropDown
        End With
        Application.EnableEvents = True
   
    Else    ' response was NOT vbYes
        MsgBox Me.ComboBox1.Value & vbCrLf & "will be cleared from the ComboBox" & vbCrLf & _
               "and NOT added to the drop down list"
        ' clear entry
        Me.ComboBox1.Value = ""
        ' maintain focus
        Cancel = True
        Exit Sub
    End If
    
End If

End Sub

Then this should be all that's needed to write to the QUOTES sheet

Private Sub SendToWorksheet_Click()
      
    Application.ScreenUpdating = False

    With Sheets("QUOTES")
        .ListObjects("Table42").ListRows.Add 1, True
        .ListObjects("Table42").DataBodyRange.RowHeight = 25
       .Range("D2") = Me.ComboBox1.Text ' VEHICLE
       .Range("H2") = Me.ComboBox2.Text ' DESCRIPTION OF JOB
       .Range("K2") = Me.ComboBox3.Text ' PAYMENT
       .Range("I2") = Me.ComboBox4.Text ' MILEAGE THERE & BACK
       .Range("A2") = Me.TextBox1.Text ' NAME
       .Range("B2") = Me.TextBox2.Text ' TELEPHONE
       .Range("C2") = Me.TextBox3.Text ' POST CODE
       .Range("E2") = Me.TextBox4.Text ' VEHICLE REG
       .Range("F2") = Me.TextBox5.Text ' QUOTED
       .Range("G2") = Me.TextBox6.Text ' DATE OF QUOTE
       .Range("J2") = Me.TextBox8.Text ' VIN
    End With
    
    Application.ScreenUpdating = True
    
    Unload QuotesForm
    Range("A1").Select
    ActiveWorkbook.Save
      
End Sub

 

[ipbr21054]

I have now added the codes above.

This is what i notice.
I select the ComboBox & type FERRARI as its not in the drop down liast.
I complete the other fields.
I then select SEND TO QUOTES DATABASE
I see the Msg about its not in the drop down etc so i select YES.
So what i see not is that the drop down has now get the added car in the list.
BUT what i just typed in the field is no longer there so i assume im supposed to now go through the list & make the selection.

At this point cant we just have the code select / put it there as im then doing it twice otherwise ?

I see when i then press SEND TO QUOTES DATABASE again the curcor goes around & around a few times.
I also see the cursor is now a large white cross like the flag of switzerland ???
I also notice if i go to the INFO sheet the table where the car was just added is all dark grey, see screenshot attached

Selecting any cell outside of column B puts it back to its correct colours.

With respect the big white cross as a cursor i see it now on the other sheets as opposed to an arrow ?

 

[NoSparks]

I select the ComboBox & type FERRARI as its not in the drop down liast.
I complete the other fields.
I then select SEND TO QUOTES DATABASE
I see the Msg about its not in the drop down etc so i select YES.

Are you sure?
I don't believe focus can leave the combo box unless its value is empty or FERRARI is in the list.
If things are as you state then abandon what I've posted and go with what you got.
No point addressing anything else if that's the case.

 

[ipbr21054]

Ive tried again this morning.
Complete first 3fields
Select Vehicle List field.
I type ROLLS
I tab to go to next field & this is when i see the message ENTRY IS NOT IN DROP DOWN
I click on YES to add it.
Now what i see is the drop down list in a drop down state thus me being able to see the values in drop down.
If i click anywhere on the form the drop down closes but what i had type isnt shown in the field.
I reselect the drop down & can navigate to the newly added vehicle.
I complete the other fields & select SEND TO QUOTES DATABASE


See attached short video clip.
You will see after entering FERRARI when i click away from list FERRARI is no longer shown.

You will also see that the table on INFO sheet has changed colour unless i click outside of table.

You will also see the cursor is now a fixed large white cross

TEST VIDEO CLIP

 

[ipbr21054]

UPDATE

Ive read through the code & commented out a line.
Now when i type in the VEHICLE LIST field the vehicle is still shown & not removed,see attached screenshot.
Having said that the drop down is still in a drop down state,is this normal or can it be closed ?

I continue to complete the other fields & i am able to send values to worksheet fine.

I just go take a look at the table on the INFO sheet & notice its still greyed out ?
Also see screen shots of it all greyed out & how it looks when i click anothe cell etc.

Thanks

 

[ipbr21054]

Regards post 16 i thought the following would work just by selecting another cell on the INFO sheet once code has finished sorting A-Z but the following didnt work for me when i placed it in various cells range etc to see it it would be ok

Range("A1").Select

The above would work if the code i mention was placed in the correct part of the code.


I believe my last issue is the closing of the drop down list after the new value was entered.

I enter vehicle to field,i click on yes to be added & note what i now see is supplied in screenshot attached.
I thought by adding the following would close the drop down list but maybe i got that wrong ?
After new vehicle is added im thinking of putting focus on next TextBox being number 4 thus closing the drop down list.

I tried this.

Me.TextBox4.SetFocus

Make Sense ?

 

[NoSparks]

Good morning,
replace the _BeforeUpdate sub with this one

Private Sub ComboBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Dim response As Integer
    Dim oNewRow As ListRow

' if combo empty stop here
If Len(Me.ComboBox1.Value) = 0 Then Exit Sub

' is entry in drop down
If Not Me.ComboBox1.MatchFound Then
    ' ask if to add entry to list
    response = MsgBox("Entry is not in the drop down" & vbCrLf & _
                      "Do you want to add it ?", vbYesNo)
    
    If response = vbYes Then
        
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        
        ' add row to table
        With Sheets("INFO").ListObjects("Table2")
            Set oNewRow = .ListRows.Add
            ' put what was entered into list
            oNewRow.Range.Cells(1) = Me.ComboBox1.Value
            '** SORT A=Z HERE **
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=.ListColumns(1).Range, SortOn:=xlSortOnValues, _
                                    Order:=xlAscending, DataOption:=xlSortTextAsNumbers
            With .Sort
                .Header = xlYes
                .Apply
            End With
            Application.Goto (.HeaderRowRange.Cells(1))
        End With
                
        ' re-activate QUOTES sheet
        Sheets("QUOTES").Select
        
        ' assign the new list to combo
        With Me.ComboBox1
            ' maintain focus
            Cancel = True
            ' reload drop down
            .List = Sheets("INFO").ListObjects("Table2").DataBodyRange.Value
        End With
        
        Application.ScreenUpdating = True
        Application.EnableEvents = True
   
    Else    ' response was NOT vbYes
        MsgBox Me.ComboBox1.Value & vbCrLf & "will be cleared from the ComboBox" & vbCrLf & _
               "and NOT added to the drop down list"
        ' clear entry
        Me.ComboBox1.Value = ""
        ' maintain focus
        Cancel = True
        Exit Sub
    End If
    
End If

End Sub

PS: I didn't see any Swiss flags in your video

 

[ipbr21054]

Thats better.
Is it possible to Me.TextBox4.SetFocus after new value added to table & taken back to quotes form,this is where before the drop down would still be opened.
At present cursor still in vehicle list field.

Here is the cusor which is now a large white cross

VIDEO CLIP

 

[NoSparks]

Is it possible to Me.TextBox4.SetFocus after new value added to table & taken back to quotes form,this is where before the drop down would still be opened.
At present cursor still in vehicle list field.

You don't really read the code or the comments do you ?
See in the code where the comment is
' assign the new list to combo
and below that the comment is
' maintain focus

Comment out
Cancel = True

Here is the cusor which is now a large white cross

That looks normal to me.
Nothing in my code will change the behavior of your Excel mouse pointer.