Public MySearchString As String
Public MySearchSheet As String

Sub FillDropDown(ByRef MyRow As Integer, MyColumn As Integer, MySheet As String, MySearchString As String, MySearchSheet As String)

' Copyright Abbydale Systems LLC. 2019 

' This routine will fill a column with a dropdown list defined on a different spreadsheet

' Parameters are:
' MyRow          : The row to start placing the dropdown in
' MyColumn       : The column to place the dropdown in
' MySheet        : The name of the sheet to place the dropdown on.
' MySearchString : The string that is the header for column on the sheet where the dropdown is
'                  to be placed.  
' MySearchSheet  : The sheet containing the values to use for the dropdown list. The sheet must have a 
'                  column that is the same name as the sheet that will contain the dropdown. 
  
With ThisWorkbook.ActiveSheet
    Set findCell = .Cells.Find(what:=MySearchString, LookIn:=xlValues, LookAt:=xlWhole)
    If findCell Is Nothing Then
        MsgBox "Sheet Invalid. " & MySearchString & " not found", vbCritical
        MySheet = "Whoops"
        Exit Sub
    End If
End With
If MyColumn <> findCell.Column Then Exit Sub
If MyRow < findCell.Row Then Exit Sub
If MyRow = findCell.Row Then
    Answer = MsgBox("Are you sure you want to reload the " & MySearchString & " dropdown?", vbYesNo + vbQuestion, "Reload Dropdown")
    If Answer = vbNo Then Exit Sub
        With ThisWorkbook.Worksheets(MySearchSheet)
            Set findCell = .Cells.Find(what:=ActiveSheet.Name, LookIn:=xlValues, LookAt:=xlWhole)
            If findCell Is Nothing Then
                MsgBox ActiveSheet.Name & " not found in " & MySearchSheet & " sheet." & vbCrLf & vbCrLf & "Please add it before continuing", vbCritical
                MySheet = "Whoops"
                Exit Sub
            End If
            LastRow = ThisWorkbook.Sheets(MySearchSheet).Cells(Rows.Count, findCell.Column).End(xlUp).Row
 '
 '           Commented out code will do strings less then 256 characters
 '
 '           aStr = " "
 '           For Each Value In ThisWorkbook.Sheets(MySearchSheet).Range(Cells(findCell.Row + 1, findCell.Column).Address(), Cells(LastRow, findCell.Column).Address())
 '               If aStr = " " Then
 '                   aStr = Value
 '               Else
 '                   aStr = aStr & "," & Value
 '               End If
 '           Next Value
  
            aStr = "='" & MySearchSheet & "'!" & Cells(findCell.Row + 1, findCell.Column).Address & ":" & Cells(LastRow, findCell.Column).Address
            LastRow = Cells(Rows.Count, MyColumn).End(xlUp).Row
            If MyRow = LastRow Then
                LastRow = LastRow + 1
            End If
            MyRow = MyRow + 1
            With ThisWorkbook.ActiveSheet.Range(Cells(MyRow, MyColumn).Address(), Cells(LastRow, MyColumn).Address()).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                    Formula1:=aStr
                '.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=aStr
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = "Select Item"
                .ErrorTitle = ""
                .InputMessage = "Select the item from the drop down"
                .ErrorMessage = "What?"
                .ShowInput = True
                .ShowError = True
            End With
            MySheet = ActiveSheet.Name
        End With
End If
End Sub
'
'  Example of how to call the FillDropDown SubRoutine 
'
'  Note that this will insert the drop down list in the column that has focus
'  starting in the row with focus and ending at the first empty cell in the column
'
If findCell.Column = Target.Column Then
    MySearchString = "FindHeaderString"
    MySearchSheet = "SheetContainingTheValues"
    Call FillDropDown(Target.Row, Target.Column, ActiveSheet.Name, MySearchString, MySearchSheet)
End If