Sub BuildDropDowns(cell)
        Dim Drops As Dropdown
        App_Sheet.Range(cell).Select
        Set Drops = App_Sheet.DropDowns.Add(540, 247.5, 103.5, 15.75)
        Drops.ListFillRange = "$S$2:$S$9"
        Drops.LinkedCell = cell
        Drops.DropDownLines = 8
        Drops.Display3DShading = False
        Set Drops = Nothing
End Sub

Sub BuildDropDowns(cell)
        App_Sheet.Range(cell).Select
        Dim Rang As Range
        Set Rang = App_Sheet.Range(cell)
        Dim Drops As Dropdown
        Set Drops = App_Sheet.DropDowns.Add(540, Rang.Top, 103.5, 15.75)
        Drops.ListFillRange = "$S$2:$S$9"
        Drops.LinkedCell = cell
        Drops.DropDownLines = 8
        Drops.Display3DShading = False
        Set Drops = Nothing
        Set Rang = Nothing
End Sub

Sub testDropdowns()
    Dim rngAdd As Range
    Dim rngList As Range
    Dim wksadd As Worksheet
    
    Set rngAdd = Cells(2, 4) ' Range("D1")
    Set rngList = Range(Cells(1, 1), Cells(8, 1))
    Set wksadd = Worksheets("Sheet1")
    
    Call subAddDropDown(wksadd, rngAdd, rngList)

    Set rngAdd = Nothing
    Set rngList = Nothing
End Sub

Sub subAddDropDown(wksadd As Worksheet, rngAdd As Range, rngList As Range)
    Dim dp As DropDown
    'add a dropdown to the cell rngAdd
    Set dp = wksadd.DropDowns.Add(rngAdd.Left, rngAdd.Top, _
                                        rngAdd.Width, rngAdd.Height)
    'set the dropdown properties
    With dp
        .ListFillRange = rngList.Address
        .LinkedCell = rngAdd
        .DropDownLines = rngList.Rows.Count
    End With
        
    Set dp = Nothing
End Sub