Dynamic dropdownlist from productlist

[Reiniervdijk]

Hi there,

I'm not good in programming and I hoped that people could help me on this platform.

I have made a macro that makes a productlist.
However some options of this productlist sometime need to be changed.
So I want a macro that scans my productlist and makes dropdownlists based on the list.

What this macro needs to do is:

1. It has to search for a word from the (productlist) subjectlist in another sheet.
   
   1. To do this correctly a cell before the subjectcell contains always: frm .
      
      1. Something I can"t find is the lookup function that is as follows: frm >cell< - (cell to the right)- Subject >Cell<
      
      
   
   
2. When cell is found then select till end > without the last row! named: Next
3. Then it needs to make a defined name for the selection.
   
   1. Code
      
      1. Application.CutCopyMode = False
      2. Selection.CreateNames Top:=True, Left:=False, Bottom:=False, Right:=False
      
      
   
   
4. When the name is made there has to come a dropdownlist made specially for the subject cell
5. And then is has to loop till the end of the productlist.

The code is missing the loop and automatically search option and make dropdownlist.

Sub test()
'
' test Macro
        Range("B4").Select
    
        Selection.Copy
    
        Range("C4").Select
    
        Cells.Find(What:="subject 1", After:=ActiveCell, LookIn:=xlFormulas2, _
                          LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                          MatchCase:=False, SearchFormat:=False).Activate
    
        Sheets("Sheet1").Select
    
   Cells.FindNext(After:=ActiveCell).Activate
       Range(Selection, Selection.End(xlDown)).Select
 
    
    Application.CutCopyMode = False
        Selection.CreateNames Top:=True, Left:=False, Bottom:=False, Right:= _
            False


       Sheets("Sheet2").Select
       Range("C4").Select
    
       With Selection.Validation
              .Delete
              .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                     xlBetween, Formula1:="=subject_1"
             .IgnoreBlank = False
             .InCellDropdown = True
             .InputTitle = ""
             .ErrorTitle = ""
             .InputMessage = ""
             .ErrorMessage = ""
             .ShowInput = True
             .ShowError = True
       End With
    
End Sub

[Reiniervdijk]

Hi I ve made some changes in the file so that is becomes more clear.

[p45cal]

Select the cells containing the subject names before running the macro below (cells B5:B7 on your attached file); it will add data validation to the cells to the right of the selected cells. I haven't bothered naming the ranges.

Sub blah()
Dim foundcll As Range, myNextRng As Range, myListRng As Range

Set myRng = Selection
For Each cll In myRng.Cells
  Set foundcll = Sheets("Sheet1").UsedRange.Find(cll.Value, LookIn:=xlFormulas, LookAt:=xlWhole, SearchFormat:=False)
  If Not foundcll Is Nothing Then
    Set myNextRng = Range(foundcll, foundcll.End(xlDown)).Find(What:="Next", After:=foundcll, LookIn:=xlFormulas2, LookAt:=xlPart, SearchFormat:=False)
    If Not myNextRng Is Nothing Then
      Set myListRng = Range(foundcll.Offset(1), myNextRng.Offset(-1))
      With cll.Offset(, 1).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & myListRng.Address(external:=True)
      End With
    End If
  End If
Next cll
End Sub