VBA Excel adding dynamic validation list to multiple cells

[Lokesh3_14]

I have created two drop down list of country and city which are dependent using this:

https://siddharthrout.wordpress.com/...ent-lists-vba/

However, now the issue is that I would like to create similar drop-downs below it using the same code in the file.

So I replaced Range("B2") with Range("B2:B11") and Range("C2") with Range("C2:C11") everywhere in the code.

But this is now giving the error 'Type Mismatch' and therefore not generating the required output. I am not good in vba so I am not able to understand what else should I change. Any help is greatly appreciated!

Also, for country Australia in cell B2 in sheet 1, it is showing Sydney and NSW separately which I want to be together.

Thanks in advance!

[dflak]

This is one of my favorite techniques for cascading drop-down lists. Check it out to see if it will work for you.
http://www.utteraccess.com/wiki/inde...ists_%28VBA%29

[jaslake]

Hi Lokesh3_14

Welcome to the Forum!!!

I didn't rewrite your existing Code, merely modified it. As dflak noted, there are other ways to do this...some better than others. Modified Code..

Private Sub Worksheet_Change(ByVal Target As Range)

   Dim i As Long, LastRow As Long, n As Long
   Dim LR           As Long
   Dim MyCol        As Collection
   Dim SearchString As String, Templist As String

   Application.EnableEvents = False

   LR = Range("A" & Rows.Count).End(xlUp).Row


   On Error GoTo Whoa

   ' Find LastRow in Col A
   LastRow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row

   If Not Intersect(Target, Columns(1).EntireColumn) Is Nothing Then
      Set MyCol = New Collection

      ' Get the data from Col A into a collection
      For i = 4 To LastRow
         If Len(Trim(Sheet2.Range("A" & i).Value)) <> 0 Then
            On Error Resume Next
            MyCol.Add CStr(Sheet2.Range("A" & i).Value), CStr(Sheet2.Range("A" & i).Value)
            On Error GoTo 0
         End If
      Next i

      ' Create a list for the Data Validation List
      For n = 1 To MyCol.Count
         Templist = Templist & "," & MyCol(n)
      Next

      Templist = Mid(Templist, 2)

      Range("B2:B" & LR).ClearContents: Range("B2:B" & LR).Validation.Delete

      ' Create the Data Validation List
      If Len(Trim(Templist)) <> 0 Then
         With Range("B2:B" & LR).Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Templist
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
         End With
      End If

      ' Capturing change in cell A2
   ElseIf Not Intersect(Target, Range("B2:B" & LR)) Is Nothing Then
      SearchString = Target.Value
      'SearchString = Range("B2").Value

      Templist = FindRange(Sheet2.Range("A2:A" & LastRow), SearchString)

      'Range("C2:C" & LastRow).ClearContents
      ' Range("C2:C" & LastRow).Validation.Delete
      Cells(Target.Row, "C").Validation.Delete

      If Len(Trim(Templist)) <> 0 Then
         ' Create the DV List
         With Cells(Target.Row, "C").Validation
            '    With Range("C2:C" & LastRow).Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Templist
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
         End With
      End If
   End If
LetsContinue:
   Application.EnableEvents = True
   Exit Sub
Whoa:
   MsgBox Err.Description
   Resume LetsContinue
End Sub

[Lokesh3_14]

Hi John,

Thanks very much for your help! That worked like a charm for me. Sure I will mark my Thread as SOLVED.

Kind Regards,
Lokesh

[jaslake]

You're welcome...glad I could help.

If you're satisfied by any members response to your issue please use the star icon at the lower left of their post.