Import ComboBox value from Excel into MS ACCESS 2003 database via vba

I created a datasheet in excell that I email out to users.  I would like them to enter updates.  I password protect the sheet so that they can only make changes to the third column (updates only).  I ended up adding combo boxes to some of the rows, without knowing that the comboboxes are objects instead of regular validation.

I may have to hand enter the completed form values from persons that already sent the form back.  I have two questions, how do you read in the combobox value selected?  If you can not do this, can you suggest some VBA code to create a value list drop down in a cell that is based off another cell value range?  In the second approach, during the next collection, I would hide the value list and protect the sheet so users could not edit it.

I've attached a sample sheet to demonstrate the drop down (combobox) that does not currently import correctly.
test.xls
atljarmanAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

andrewssd3Commented:
How did you get the drop-down values into the combo boxes?  They look like form controls, but I would normally expect to see the input source set when you select Format control from the right click menu.  I can't find any useful properties for them when I read them as ControlSource objects in VBA
Jeffrey CoachmanMIS LiasonCommented:
I have requested that the Excel Zone be added to this Q...
atljarmanAuthor Commented:
Here is the VB that I used to create the drop down boxes:

        With .Range("C12:C12")
            Set xlComb = xlWS.DropDowns.Add(.Left, .Top, .Width, .Height)
        End With
        With xlComb
           .AddItem "Full-Time"
           .AddItem "Part-Time"
        End With

Sorry for the delay, family sickness and travel has kept me away.
10 Tips to Protect Your Business from Ransomware

Did you know that ransomware is the most widespread, destructive malware in the world today? It accounts for 39% of all security breaches, with ransomware gangsters projected to make $11.5B in profits from online extortion by 2019.

andrewssd3Commented:
This code reads the value from the dropdown and places it in the cell to the right.  Some cells have more than one dropdown and some are not properly initialised, hence the error handling.  If there is more than value in the dropdown, I have copied the value into the first empty cell to the right

The Dropdown object you have used is now a hidden object, presumably because MS want you to use ActiveX objects instead - I had never come across this one.  I'll post some code to add a more standard dropdown in a few minutes.

Sub ExtractDropdownText()

    Dim d As Excel.DropDown
    Dim vVal As Variant
    Dim rngOut As Excel.Range
    
    For Each d In ActiveSheet.DropDowns
        vVal = Empty
        On Error Resume Next
        vVal = d.List(d.ListIndex)
        On Error GoTo 0
        
        If Not IsEmpty(vVal) Then
            ' place the value in the first empty cell to the right of the dropdown
            ' (some cells have more than one dropdown)
            Set rngOut = d.TopLeftCell.Offset(0, 1)
            Do While Not (IsEmpty(rngOut.Value))
                Set rngOut = rngOut.Offset(0, 1)
            Loop
            rngOut.Value = vVal
        End If
    Next d
    
    
End Sub

Open in new window

andrewssd3Commented:
OK - I think this will give you a more standard dropdown box - the ActiveX version:
Public Sub AddDropdown(ByRef rngCell As Excel.Range, ByRef rngFill As Excel.Range)
    
    Dim o As Excel.OLEObject
    Dim cbx As MSForms.ComboBox
    
    With rngCell
        Set o = ActiveSheet.OLEObjects.Add( _
            ClassType:="Forms.ComboBox.1", Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
        Set cbx = o.Object
        
        With cbx
            .LinkedCell = rngCell.Address(True, True, xlA1, True)
            .ListFillRange = rngFill.Address(True, True, xlA1, True)
            .SpecialEffect = fmSpecialEffectFlat
            .BorderStyle = fmBorderStyleSingle
        End With
        
    End With

End Sub

Open in new window


You call this with for example
call AddDropdown(Range("H4"),Range("j5:j6"))

Open in new window

It will create the combo box as you did before, over the cell you specify in the first parameter.  The box is linked to the cell you specify, so whatever your users choose will be the value in the cell under the box - they can't change this directly as the box sits over it.  The second parameter is the listfillrange, which specifies the range from which the values for the dropdown are taken.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
atljarmanAuthor Commented:
Hi,

I recieved an error with this line of the code:

cbx As MSForms.ComboBox

With this error: "User-defined type not defined"

Any thoughts on how to resolve?
atljarmanAuthor Commented:
andrewssd3,

What References in the Object Library do I need to have active for this function to work.  I think that I might not have the reference required.
andrewssd3Commented:
Yes you need to add a reference to Microsoft Forms 2.0 Object Library - I already had that.  You do it through Tools...References from the VBA editor, then find and check it in the list
atljarmanAuthor Commented:
Microsoft Forms 2.0 Object Library is not avaialble in the Library.  How do you add it?
andrewssd3Commented:
You should have it.  If you add a userform to your project it should automatically add the reference - then you can remove the userform and the reference stays..
atljarmanAuthor Commented:
Great News!  It works one time.  I imported the information and it showed up in my database like a charm.

The problem is that I will need to make a few hundred spreadsheets from a database.  If I run one excel spreadsheet and close the application and run one spreadsheet again, it works fine.  If I try to run two spreadsheets or run it more than once, there is a Global error.  

I think that something in the Public Sub code is not referenced correctly, such as Set to 'Nothing'.  I don't really know how to determine where the information needs to be referenced, and I spent about 4 hours trying, but this is where someone else has helped in the past.

I've attached a sample db that creates the sample spreadsheet from one table to mimic what I am trying to do.   I have asked it to make two excel (from the same data) spreadsheets to mimic the error I am getting.

Any suggestions would be greatly appreciated.  Sorry that I am not more up on which one of these variables is remaining open and causing the error.
test-wdropdown.mdb
andrewssd3Commented:
I have not been able to test this fully, but it looks like you need to change the AddDropDown calls to use the Worksheet range with .Range as you do in the code above
        Call AddDropdown(.Range("C12"), .Range("D5:D6"))

Open in new window

Also in Line 7 of the AddDropdown code, you need to change to
         Set o = rngCell.Worksheet.OLEObjects.Add( _
            ClassType:="Forms.ComboBox.1", Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)

Open in new window

That removes the dependency on having an activeworksheet.  I think that will work.
atljarmanAuthor Commented:
andrewssd3,

I will try this today and let you know if it works.  Thanks for your help.
atljarmanAuthor Commented:
This worked.  I created about 40 files and all have imported with the data from the drop down.  Thanks much.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.