VBA Code to Extract Data from a List and Making a Validation

[OilEconomist]

Hello and thanks in advance for your assistance. I would like to make a data validation on a particular sheet by extracting entries from a column on another sheet. I would also like to eliminate any duplicate values from the list.

My issue is how to get the values to appear in the formula bar. I would like to not use name ranges. I am having issues with the following line of code.

    Sheets("Plan.Loader").Range("A7").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=RngDatVal

So basically is there some way for it to automatically extract and input the values into the formula to get this:

    Sheets("Plan.Loader").Range("A7").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="Dog,Cat,Bird,Mouse"

The code is as follows. Also, how much does the code change if it needs to eliminate any duplicates values from the range. In terms of ensuring that none of the values repeat themselves in the data validation?

Sub DatVal()

'Dimensioning
   Dim ShtNm As String
   Dim LastRow As Long
   Dim RngDatVal As Range
  
  
Sheets("Plan.Loader").Activate

'Code
    ShtNm = "Plan.2022.02.28"

    With Sheets(ShtNm)
       Set RngDatVal = .Range("C9:C17")
    End With

    Sheets("Plan.Loader").Range("A7").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Formula1:=RngDatVal


End Sub

 

[Fluff]

Is the range of values only C9:C17?

 

[mumps]

Try:

Sub DataVal()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, dic As Object
    v = Sheets("Plan.2022.02.28").Range("C9:C17").Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v) To UBound(v)
        If v(i, 1) <> "" Then
            If Not dic.exists(v(i, 1)) Then
                dic.Add v(i, 1), Nothing
            End If
        End If
    Next i
    With Sheets("Plan.Loader").Range("A7").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(dic.Keys, ",")
    End With
    Application.ScreenUpdating = True
End Sub

Change the range to suit your needs.

 

[OilEconomist]

Is the range of values only C9:C17?

Thanks so much @Fluff for reviewing my code and responding so quickly with a question. Your help is always welcome.

It varies, but I was going to find the last row and just make the change.

 

[Fluff]

How many values could you possibly have, as there is a limit to the size of text string allowed?

 

[OilEconomist]

Try:

Sub DataVal()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, dic As Object
    v = Sheets("Plan.2022.02.28").Range("C9:C17").Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v) To UBound(v)
        If v(i, 1) <> "" Then
            If Not dic.exists(v(i, 1)) Then
                dic.Add v(i, 1), Nothing
            End If
        End If
    Next i
    With Sheets("Plan.Loader").Range("A7").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(dic.Keys, ",")
    End With
    Application.ScreenUpdating = True
End Sub

Change the range to suit your needs.

Thanks @mumps for your quick response and the solution. This works. I just need to dissect it a bit as the code is far more advanced than my VBA abilities. It was pretty slick on how you coded it.

 

[OilEconomist]

How many values could you possibly have, as there is a limit to the size of text string allowed?

Hi @Fluff. Not sure, but for now I don't think I need any more than 10, but this number could change in the future. I just don't think it will be anything over 15 or 20.

 

[Fluff]

In that case you also use this, which will ignore blank cells

Sub OilEconomist()
   Dim Dic As Object
   Dim Cl As Range
  
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Plan.2022.02.28")
      For Each Cl In .Range("C9", .Range("C" & Rows.count).End(xlUp))
         If Cl.Value <> "" Then
            Dic(Cl.Value) = Empty
         End If
      Next Cl
   End With

   With Sheets("Plan.Loader").Range("A7").Validation
      .Delete
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(Dic.Keys, ",")
   End With
End Sub

 

[OilEconomist]

In that case you also use this, which will ignore blank cells

Sub OilEconomist()
   Dim Dic As Object
   Dim Cl As Range
 
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Plan.2022.02.28")
      For Each Cl In .Range("C9", Range("C" & Rows.count).End(xlUp))
         If Cl.Value <> "" Then
            Dic(Cl.Value) = Empty
         End If
      Next Cl
   End With

   With Sheets("Plan.Loader").Range("A7").Validation
      .Delete
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(Dic.Keys, ",")
   End With
End Sub

Thanks @Fluff as this also works, but only if Sheets("Plan.2022.02.28") is active. When I am on any other sheet, it gives me the error "Run-time error '1004': Application-defined or object-defined error" for the following line of code:

or Each Cl In .Range("C9", Range("C" & Rows.Count).End(xlUp))

The code @mumps posted also eliminates the spaces/blank entries.

 

[Fluff]

Thanks @Fluff as this also works, but only if Sheets("Plan.2022.02.28") is active.

You're quite right I missed a period before the 2nd Range on that line, I've edited the code in post#8 to correct that.

The code @mumps posted also eliminates the spaces/blank entries.

It does indeed.