Combo box -- dynamic -- modify existing VBA


I need some assistance with modifying the VBA in an existing XLS (see spreadsheet).

Attached XLS contains sample data where cells A2:C2 are drop-down menus.  

Combo box (A2) currently shows four (4) values.   If the value does not exist, user can simply enter the new value and the, e.g., new (5th) values becomes available.   Same applies to B2 and C2.   So far so good.

Instead of using the "California" (example) drop-down box in only A2, I want to be able to copy/paste the combo into A3:A10.   At this time all previously existing drop down values are available.  However, in the event a user adds a new value to combo A10, it will only be available in A10 (vs. A2 through A10).

My question:   How can the code be modified so that the entire "California" combo values are not added to the "Data Validation List" but instead to e.g. a new sheet in column A.   Then, maybe I could use a dynamic lookup (Offset) where any new values would update the combo (which is linked to that range).   I hope that makes sense.

Ultimately, I simply need to be able to have a combo where new values can be dynamically added to the combo and all combos in the same column will show the newly added value.   Any idea how to accomplish this modification?

Thank you,
Who is Participating?

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

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.

Martin LissOlder than dirtCommented:
Are you saying that if I add, say, 'Rancho Cucamonga' (an actual city) to the combo in A3 and 'Santa Monica' to the combo in A4 that you want A3 to show Los Angeles, Rancho Cucamonga, Sacramento, San Diego and San Francisco and the one in A4 to show Los Angeles, Sacramento, Santa Monica, San Diego and San Francisco?

If that's true then so that I can better understand your requirement, please explain why you need to do that.
Ejgil HedegaardCommented:
Add this line just before the modify, and the changes will be made for all validations in the same column.
Set rngCheck = rngCheck.SpecialCells(xlCellTypeSameValidation)

And expand the monitor ranges to row 10.
Then the code will be
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errhandler
    Dim astrNewData() As String, lngEntryCount As Long, rngMonitor As Range, rngCheck As Range
    'Adjust line below to add more ranges
    Set rngMonitor = Union([A2:A10], [B2:B10], [C2:C10])
    Set rngCheck = Intersect(Target, rngMonitor)
    If (Not rngCheck Is Nothing) Then
        curlist = rngCheck.Validation.Formula1
        If (InStr(curlist, rngCheck) = 0) Then
            astrNewData = Split(curlist, ",")
            lngEntryCount = UBound(astrNewData) + 1
            ReDim Preserve astrNewData(lngEntryCount)
            astrNewData(lngEntryCount) = rngCheck
            astrNewData = BubbleSort(astrNewData)
            Set rngCheck = rngCheck.SpecialCells(xlCellTypeSameValidation)
            rngCheck.Validation.Modify Formula1:=Join(astrNewData, ",")
        End If
    End If
    Exit Sub
    With rngCheck.Validation
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=" "
    .ShowError = False
    End With
End Sub

Open in new window


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
ExpExchHelpAnalystAuthor Commented:
Ejgil  -- your solution is brilliant!   Thousand thanks for your assistance.
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

From novice to tech pro — start learning today.