Macro to Provide Validation List

I am looking for worksheet code that will bring back all values from a second worksheet from columnA to create a validation. For purposes of this worksheet the active worksheet will be "Sheet1" and the values will be in worksheet "Recommendations". What I am looking for is the cell A4 of "Sheet1" to be a validation of all items in ColumnA of "Recommendations" starting after Row1 (Header Row). I have tried adjusting similar code I have in another workbook but can not seem to get the right application. (Not very good at writing VBA yet still learning how to interpret)Thanks in advance.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
    With Sheets(Target.Value) = "Recommendations"
        Set Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
        Rng.Name = "NamedRng"
    End With

    With Range("A4").Validation
        Range("A4") = Rng(1)
        .Delete
        .Add Type:=xlValidateList, Formula1:="=NamedRng"
    End With
End If
End Sub

Why not just create a validation manually and use some of that code for the Change event for the Recommendations sheet to set the range for the named range?

Of course a dynamic named range formula for the name would negate the need for any VBA.

its probably due to context issues but as I develop my workbooks I usually run into complications with manual validations. I have found it more efficient to utilize vba to populate the validation but as I said that is my own experience. I was hoping potentially that someone could help me adjust the code issues to create the validation I was looking for.

I find that very odd as you manually have to enter VBA code.

In any case, if you like, I could show you how to make the listing unique and sorted. If not, it is easy enough to just use the named range.

Obviously, the code should be in the Recommendations sheet. When the NamedRng is changed, the validation list would change.

If you want me to make this more simple, I can do that. Most would prefer a sorted no duplicate list I suspect.

Insert this into a Module. Be sure to add the reference as commented (VBE's menu: Tools > References > Microsoft Scripting Runtime)

Function RangeTo1dArray(aRange As Range) As Variant
  Dim a() As Variant, c As Range, i As Long
  ReDim a(0 To aRange.Cells.Count - 1)
  i = i - 1
  For Each c In aRange
    i = i + 1
    a(i) = c
  Next c
  RangeTo1dArray = a()
End Function

' http://www.excelforum.com/excel-programming-vba-macros/819998-filter-and-sort-scripting-dictionary.html
'Early Binding method requires Reference: MicroSoft Scripting Runtime, scrrun.dll
Function UniqueArrayByDict(Array1d() As Variant, Optional compareMethod As Integer = 0, _
  Optional tfStripBlanks = False) As Variant
  'Dim dic As Object 'Late Binding method - Requires no Reference
  'Set dic = CreateObject("Scripting.Dictionary")  'Late or Early Binding method
  Dim dic As Dictionary     'Early Binding method
  Set dic = New Dictionary  'Early Binding Method
  Dim e As Variant
  dic.CompareMode = compareMethod
  'BinaryCompare=0
  'TextCompare=1
  'DatabaseCompare=2
  For Each e In Array1d
    If Not dic.Exists(e) Then
      If tfStripBlanks Or e <> "" Then dic.Add e, Nothing
    End If
  Next e
  UniqueArrayByDict = dic.Keys
End Function
 
Function ArrayListSort(sn As Variant, Optional bAscending As Boolean = True) As Variant
    With CreateObject("System.Collections.ArrayList")
        Dim cl As Variant
        For Each cl In sn
            .Add cl
        Next
         
        .Sort 'Sort ascendending
        If bAscending = False Then .Reverse 'Sort and then Reverse to sort descending
        ArrayListSort = .toarray()
    End With
End Function

Right click your Recommendations sheet's tab, View > Code, and paste:

Private Sub Worksheet_Change(ByVal Target As Range)
'On Error Resume Next
  Dim a() As Variant, r As Range
  With Target
    If .Column <> 1 Or .Row = 1 Then Exit Sub
    Set r = Range("A2", Range("A" & Rows.Count).End(xlUp))
    a() = RangeTo1dArray(r)  'Works for 2d ranges as well
    a() = UniqueArrayByDict(a)
    a() = ArrayListSort(a)
    'MsgBox Join(a, vbLf)
  End With
  
  With Sheet1.Range("A4").Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=Join(a(), ",")  '"=$A$1:$A$3"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
  End With
End Sub

[QUOTE=Kenneth Hobson;3644500][\QUOTE]

Kenneth,

Thank you for the replies. I inserted the second part of the code into the "Recommendations" worksheet and Inserted the first part in a module (not very familiar with using modules). I then tried to utilize the code but was unable to achieve the output. (by the way sheet1 is actually titled "Tracking Form"). The module conceptually has me confused as the context is something I am unfamiliar with. Is there an suspected causes for this code not to work or would it be plausibly easier to use the "Simple" version you were discussing?

[QUOTE=Kenneth Hobson;3644500]If you want me to make this more simple, I can do that. Most would prefer a sorted no duplicate list I suspect.

Insert this into a Module. Be sure to add the reference as commented (VBE's menu: Tools > References > Microsoft Scripting Runtime)
[QUOTE]

Kenneth,

I played around and came up with the following code. It seems to work as intended. You see any complications?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ws As Worksheet
Dim Rng As Range



If Target.Address(0, 0) = "A4" Then

With Sheets("Recommendations")
        Set Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
        Rng.Name = "NamedRng"
    End With


With Target.Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:="=NamedRng"
End With
End If
End Sub

Kenneth,

Thank you for all your help. Everything worked as desired.

Jared