Difficult one..

[VeKa27]

Hi you all,

Because i cannot insert a sample document, i will try to explain my problem..

Suppose you have an Excel sheet. In column A (from A1 till A20) you have text and number data (A1= Option 1, A2 = Option 2, ...).
In column B you put 20 drop-down lists that refer to column A. So if you click in cell B1 (or B2, or B3,...) you get a dropdownlist and you can select "Option 1" till "Option 20").
So far so good. But now comes my problem.
This is what i want to happen: If i select in cell B2 also 'Option 1' (same as in A1) then i want that all cells from B3 till B20 refreshes and gives as result "Option 2, Option 3,... till Option 19 then".
Simple explaining is, every cell from B2 till B20 has to look to the cell above and has to give a +1 result. And those drop-downlists has to be available in all cells B1-B20.
The top of the bill will be that also the drop-downlist refreshes an gives only the Options for selection under the cell above. For example if in cell B10 "Option 5" is selected, cell B11 gives only a list of "Option 6 till Option 20". (but that is no need)

I hope you all see what i mean an i hope someone will be smarter than me..
Thanks in advance

 

[sandy666]

Because i cannot insert a sample document

you can post link to shared excel file from OneDrive, GoogleDrive, Box.com or any similar

 

[MickG]

Try this:-
Place all this code in your data sheet:- "Sheet Module" (paste at top of code window).
To Clear and Reset basic validation list Click "C1", otherwise select from any drop down in column "B".

Option Explicit
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
Private [COLOR="Navy"]Sub[/COLOR] Worksheet_SelectionChange(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ray
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1:A20")
    
  [COLOR="Navy"]If[/COLOR] Target.Address(0, 0) = "C1" [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = Range("A" & Dn.Row + 1 & ": A20")
        [COLOR="Navy"]Next[/COLOR]
        [COLOR="Navy"]With[/COLOR] Range("B1:B20").Validation
            Application.EnableEvents = False
                .Parent.ClearContents
            Application.EnableEvents = True
            .Delete
            .Add Type:=xlValidateList, Formula1:="=" & Rng.Address & ""
        [COLOR="Navy"]End[/COLOR] With
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]


'##########

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
Application.EnableEvents = False

[COLOR="Navy"]If[/COLOR] Intersect(Target, Range("B1:B20")) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A" & Target.Row + 1 & ": A20")
    [COLOR="Navy"]If[/COLOR] Not Dic [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]With[/COLOR] Rng.Offset(, 1).Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:="=" & Dic(Target.Value).Address & ""
    [COLOR="Navy"]End[/COLOR] With
    [COLOR="Navy"]End[/COLOR] If
Application.EnableEvents = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[VeKa27]

Hi Mick,

Thanks for your answer.
I did exactly as above (and saved my file as an .xlsm) but nothing happens. Not if i change data in colomn B, not if i click in cell C1. Any suggestion?

 

[MickG]

Try this example file:-
As I said Click in "C1" to reset column "B" else select from column "B" as required.
https://app.box.com/s/wi1w6fc74b7i6puhpz8o3z4fhxydyxk1

 

[VeKa27]

Hi Mick,

Very much appreciate your help.
I tried your example and it works. But perhaps i didn't explain myself very good. What i want is what you created but with this more option: suppose column B is totally selected with option 1 till option 20. If i then change cell B2 also in option1 (so same as B1) that all cells under B2 refreshes like B3=option 2, B4=option 3, .... B20=option 19.
All options in column B will always be in ascending order but it must be possible that some cells have the same option. But never descending. (like: option 1 - 2 - 2 - 3 - 4 - 5 - 5 - 5 - 6 - 7 - ... and never: option 1 - 1 - 2 - 3 - 4 - 3 - 4 - because the second 3th option is less than the option 4 in the cell above then)
I hope you see what i mean?
A litle extra question, is it possible to implement your solution in an other document but on another location? for example in column D15 till D35 and E15 till E35? (i will then change the column letters in the vba code but i am not sure it will work)
Again Mick, Thank you.

 

[MickG]

Try sheets "Mod 1" & "Mod1 Plus"
https://app.box.com/s/1vsa0pb97w5a39gbspp6q6vd59wz2imi

 

[VeKa27]

Hi Mick,

As from now, you're my hero
I tried your code and it works as i hoped. I had 2 little issues:
1) if i select multiple times the same option, the data writes under the selection cells. Therefore i added a line " Range("E36:E56").ClearContents" to capture that so it always erases that data again.
2) if i change the last selection cell, it have an "error 424" in the code. Don't know what that means..
Great to find people as you on the internet..

 

[MickG]

Try adding the line in red:-

If Not Dic Is Nothing[COLOR="#FF0000"][B] And Target.Value <> "" [/B][/COLOR]Then
        Rw = Dic(Target.Value).Row

 

[VeKa27]

it removes the error (yes!) but the option i select isn't visible anymore. (last cell becomes empty)