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:


It has to search for a word from the (productlist) subjectlist in another sheet.

To do this correctly a cell before the subjectcell contains always: frm .

Something I can"t find is the lookup function that is as follows: frm >cell< - (cell to the right)- Subject >Cell<




When cell is found then select till end > without the last row! named: Next
Then it needs to make a defined name for the selection.

Code

Application.CutCopyMode = False
Selection.CreateNames Top:=True, Left:=False, Bottom:=False, Right:=False




When the name is made there has to come a dropdownlist made specially for the subject cell
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