Consulting

Results 1 to 3 of 3

Thread: Dynamic dropdownlist from productlist

  1. #1

    Dynamic dropdownlist from productlist

    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
    Attached Files Attached Files
    Last edited by SamT; 08-11-2020 at 08:30 AM. Reason: Addeed Code Tags and Formatted

  2. #2

    Changes in Excel file to make it more clear

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

  3. #3
    Knowledge Base Approver VBAX Wizard
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,021
    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
    p45cal - - - - -This is my signature, it appears after all my posts. Below is not directed at anyone in particular - so don't take offence! - (You might guess why it's there though)
    If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •