• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Dynamic Data Validation

ppp1812

New Member
I need help.

In the below mentioned code I need to change the Target.Address which is A13 from a single cell to a range say A20:A30. I am unable to do the same as i am new to VBA. Can someone pl. correct the code for me

Code:
Option Explicit
Dim strOriginalEntry As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iReply As Integer
If Target.Cells.Count > 1 Then Exit Sub
    If Target.Address = "$A$13" And Target <> vbNullString Then ' Change to Validated cell
      If WorksheetFunction.CountIf(Range("Names"), Target) = 0 Then 'New Name
          Application.EnableEvents = False 'Prevent Change Event Firing again while code is running.
          'Ask if they wish to add the name or not.
          iReply = MsgBox("The name " & Target & _
                  " is not part of the list, do you wish to add it.", _
                    vbYesNoCancel + vbQuestion, "ozgrid.com")
            If iReply = vbCancel Then 'Cancelled so restore orginal text
              Target = strOriginalEntry
            ElseIf iReply = vbNo Then
            'Don't add to list. That is do nothing
            Else 'Add the new name to the cell below the last name in the named range "Names"
                Range("Names").Cells(1, 1).End(xlDown)(2, 1) = Target
            End If
      End If
    End If
Application.EnableEvents = True 'Allow Events
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Pass orginal Text to the Module level Variable "strOriginalEntry"
If Target.Address = "$A$13" Then strOriginalEntry = Target
End Sub

Thanks

Prakash
 
Hi Prakash,

Replace your line of code where you check the Target.address (If Target.Address = "$A$13"........) with the below.

If Not Intersect(Target, Range("A20:A30")) Is Nothing And Target <> vbNullString Then
 
Hi Prakash,

Replace your line of code where you check the Target.address (If Target.Address = "$A$13"........) with the below.

If Not Intersect(Target, Range("A20:A30")) Is Nothing And Target <> vbNullString Then
Hi Lohith,

This works perfectly.......... THANKS a lot............
Pl. tell me... how can I become a expert like you in excel ??? I have been trying to do this since past many days and was just not able to do so ........... pl. advice how and where can i get the training for this ...
And thanks a lot once again

Prakash
 
Well... we are all learning. There is no SHORTCUTKEY for it. Practice.... Practice.... Practice.

Make yourself time to follow the Excel forums (ofcourse Chandoo is too addictive) .You have a big bunch of Ninjas, Excel experts here answering the questions. Following it regularly will definetely make you awesome in Excel.

And if you ask about the trainings, checkout Chandoo's training modules.
http://chandoo.org/wp/training-programs/
 
Well... we are all learning. There is no SHORTCUTKEY for it. Practice.... Practice.... Practice.

Make yourself time to follow the Excel forums (ofcourse Chandoo is too addictive) .You have a big bunch of Ninjas, Excel experts here answering the questions. Following it regularly will definetely make you awesome in Excel.

And if you ask about the trainings, checkout Chandoo's training modules.
http://chandoo.org/wp/training-programs/

Hi, Lohith
In the above code the data validation gets dynamically updated in the the Range "Lists" .....
Now suppose we have say different columns where we are entering data and the DV has more then One list and different columns are connected to diff DV lists. How can we do the dynamic updation for the same if there are more then one lists ...... say if there are two or more lists by the name say "Test" and " Test1".
Pl. help.

Thanks and Regards,

Prakash
 
Hi Prakash,

I need some more clarfication on this. Would you please upload a sample file with the data on it explaining your requirement. Will try to fix it . Thanks.
 
Hi Prakash,

I need some more clarfication on this. Would you please upload a sample file with the data on it explaining your requirement. Will try to fix it . Thanks.

Dear Lohith,

Attached herewith pl. find the file. In col. A & B there is DV, as you can see from the file.
However I have solved the problem as you can see from the code. what I have done is copied the code twice and just changed the Range and Targets. It seems to be working fine and as I wanted.
But I am sure that is not the right way to do so. So you may please see the code and rectify and then send me the file.
Thanks and Regards,
Prakash
 

Attachments

  • Validation.xlsm
    18.7 KB · Views: 9
Dear Lohith,

Attached herewith pl. find the file. In col. A & B there is DV, as you can see from the file.
However I have solved the problem as you can see from the code. what I have done is copied the code twice and just changed the Range and Targets. It seems to be working fine and as I wanted.
But I am sure that is not the right way to do so. So you may please see the code and rectify and then send me the file.
Thanks and Regards,
Prakash

Further to the above mentioned post.
What I would also like to do is to shift the DV Lists to another sheet in the same workbook by the name say "Lists"
Pl. help.
Rgds.,
Prakash
 
Hi Prakash,

It is a busy day for me in Office today. I will try to revise it this evening otherwise will update you tomorrow. Is that fine? Thanks.
 
Hi Prakash,

It is a busy day for me in Office today. I will try to revise it this evening otherwise will update you tomorrow. Is that fine? Thanks.

Hi Lohith,

Absolutely no problem Boss ........... do this whenever you are free.

Thanks & Regards,
Prakash
 
Ok.. Here is what I have changed to combine both the loops. Give a try.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iReply As Integer
Dim rngTemp As Range
If Target.Cells.Count > 1 Then Exit Sub
'If Not Intersect(Target, Range("A3:A30", "B3:B30")) Is Nothing And Target <> vbNullString Then ' Change to Validated cell
If Not Intersect(Target, Union(Range("A3:A30"), Range("B3:B30"), Range("AA3:AA30"))) Is Nothing And Target <> vbNullString Then ' Change to Validated cell

'Select Case UCase(Mid(Target.Address, 2, 1))
Select Case UCase(Mid(Target.Address, 2, InStr(2, Target.Address, "$") - 2))
Case "A"
Set rngTemp = Range("Fruit")
Case "B"
Set rngTemp = Range("Names")
Case "C"

End Select
If rngTemp Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(rngTemp, Target) = 0 Then 'New Name
Application.EnableEvents = False 'Prevent Change Event Firing again while code is running.
'Ask if they wish to add the name or not.
iReply = MsgBox("The name " & Target & _
" is not part of the list, do you wish to add it.", _
vbYesNoCancel + vbQuestion, "New Fruits")
If iReply = vbCancel Then 'Cancelled so restore orginal text
Target = strOriginalEntry
ElseIf iReply = vbNo Then
'Don't add to list. That is do nothing
Else 'Add the new name to the cell below the last name in the named range "Names"
rngTemp.Cells(1, 1).End(xlDown)(2, 1) = Target
End If
End If
End If
Application.EnableEvents = True 'Allow Events
End Sub
 
Copy it from here, if you have trouble copying from the above post.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iReply As Integer
Dim rngTemp As Range
If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Union(Range("A3:A30"), Range("B3:B30"), Range("AA3:AA30"))) Is Nothing And Target <> vbNullString Then ' Change to Validated cell
               
        Select Case UCase(Mid(Target.Address, 2, InStr(2, Target.Address, "$") - 2))
            Case "A"
                Set rngTemp = Range("Fruit")
            Case "B"
                Set rngTemp = Range("Names")
            Case "C"
               
        End Select
        If rngTemp Is Nothing Then Exit Sub
               
        If WorksheetFunction.CountIf(rngTemp, Target) = 0 Then 'New Name
        Application.EnableEvents = False 'Prevent Change Event Firing again while code is running.
          'Ask if they wish to add the name or not.
          iReply = MsgBox("The name " & Target & _
                  " is not part of the list, do you wish to add it.", _
                    vbYesNoCancel + vbQuestion, "New Fruits")
            If iReply = vbCancel Then 'Cancelled so restore orginal text
              Target = strOriginalEntry
            ElseIf iReply = vbNo Then
            'Don't add to list. That is do nothing
            Else 'Add the new name to the cell below the last name in the named range "Names"
                rngTemp.Cells(1, 1).End(xlDown)(2, 1) = Target
            End If
      End If
    End If
    Application.EnableEvents = True 'Allow Events
End Sub
 
Copy it from here, if you have trouble copying from the above post.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iReply As Integer
Dim rngTemp As Range
If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Union(Range("A3:A30"), Range("B3:B30"), Range("AA3:AA30"))) Is Nothing And Target <> vbNullString Then ' Change to Validated cell
             
        Select Case UCase(Mid(Target.Address, 2, InStr(2, Target.Address, "$") - 2))
            Case "A"
                Set rngTemp = Range("Fruit")
            Case "B"
                Set rngTemp = Range("Names")
            Case "C"
             
        End Select
        If rngTemp Is Nothing Then Exit Sub
             
        If WorksheetFunction.CountIf(rngTemp, Target) = 0 Then 'New Name
        Application.EnableEvents = False 'Prevent Change Event Firing again while code is running.
          'Ask if they wish to add the name or not.
          iReply = MsgBox("The name " & Target & _
                  " is not part of the list, do you wish to add it.", _
                    vbYesNoCancel + vbQuestion, "New Fruits")
            If iReply = vbCancel Then 'Cancelled so restore orginal text
              Target = strOriginalEntry
            ElseIf iReply = vbNo Then
            'Don't add to list. That is do nothing
            Else 'Add the new name to the cell below the last name in the named range "Names"
                rngTemp.Cells(1, 1).End(xlDown)(2, 1) = Target
            End If
      End If
    End If
    Application.EnableEvents = True 'Allow Events
End Sub

Hi Lohith

Thanks a Lot, the above code works perfectly fine.

However the second part of shifting the DV lists to another sheet in the same book. When I am trying to do so I am getting a debug error..... inspite of copying the correct formula.
Can you please help ?
You may do the same as and when you get time.
Thanks & Regards,
Prakash
 
Hi Prakash,

How are you shifting the DV lists to another sheet? Drag and drop , Copy Paste? and also which correct formulas are you referring about?
 
Hi Prakash,

How are you shifting the DV lists to another sheet? Drag and drop , Copy Paste? and also which correct formulas are you referring about?

Hi Lohith

If you have the file with you and if you see the formula for the "Names" DV list is as follows:

=OFFSET('Updating Validation List'!$E$12,0,0,COUNTA('Updating Validation List'!$E$12:$E$10002),1)

Now I want to create another sheet in the same workbook with the name "List" and I want all my DV lists to be in that sheet ...... so when I am making a Names list in that sheet the formula I enter is as follows:
The list starts from the A2 cell and the formula I have entered is as follows :

=OFFSET('List'!$A$2,0,0,COUNTA('List'!$A$2:$A$10002),1)

But I get a debugging error.

Pl. advice me please

Thanks and Regards,

Prakash
 
Hi Prakash,

Is this line of code failing for you?
If WorksheetFunction.CountIf(Range("Fruit"), Target) = 0 Then 'New Name

If Yes, thats because the range "Fruit" is defined in the worksheet, "Updating Validation List". You cannot refernce the named range from the other worksheet directly as in your code above.

But, what is the idea behind moving all the DVs to one sheet, if it is already working perfectly for you?
 
Hi Prakash,

Is this line of code failing for you?
If WorksheetFunction.CountIf(Range("Fruit"), Target) = 0 Then 'New Name

If Yes, thats because the range "Fruit" is defined in the worksheet, "Updating Validation List". You cannot refernce the named range from the other worksheet directly as in your code above.

But, what is the idea behind moving all the DVs to one sheet, if it is already working perfectly for you?

hi Lohith,

Thanks for your reply.

The same is working fine no doubt.
But this is for my knowledge and in case there are more columns where we have to enter DV then if it is on another sheet it makes it easy.
But more because I want to know how it can be done.
In the formula I have changed the formula from "Updating Validation List" to "List" as you can see from my previous reply. But it still does not work.
Would be happy and grateful if you can advice to me on this.

Thanks & Regards,

Prakash
 
Prakash,

Sorry for this, but am still not clear. Is that the code not working or you are not able to create the new DV lists?
 
Prakash,

Sorry for this, but am still not clear. Is that the code not working or you are not able to create the new DV lists?


Hi Lohith,

The code is working fine.
I want to have the DV lists on a different sheet in the same book. When I am doing this I am getting debug error.
Let me explain......... currently the DV list is on the same sheet as the cells where we are entering the items from the DV lists. I need to move the DV list to another worksheet in the same workbook. Here I am failing to do so .....
I hope I have been able to explain what I need to learn.

Pl. revert.

Thanks & regards,

Prakash
 
Hi Prakash..
Just few words... :)
* Excel use DV from same workbook.. but want to Violated by giving it a name and call from another sheet. - No Problem.
* We use DV to restrict some entry.. but want to Violated by asking user, if he wants to add. - again No Problem.

So.. basically
* after enter data.. you want a MsgBox.. "This Target.Value is not in the Sheets("list"), Please add this value in the end of the list...

or do you really need a DV, with named range-scope workbook, and a dropdown sign when selecting cell and combobox with all unique data..
 
Hi Debraj / Lohith

Attached herewith pl the excel file.

In the first sheet ........ you can enter data in col. A and B from a DV list which is on sheet two ie "List"
However I am getting a error when I am using the DV list to enter data in col A or B in first sheet.
Also if you enter Items which are not in the DV list they are not getting updated.
The DV List on the second sheet (List)
Pl. solve my problem.

Thanks and Regards

Prakash
 

Attachments

  • DDV.xlsm
    20 KB · Views: 5
Can you please check this..

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iReply As Integer, rngTemp As Range
'Dim rngTemp As Range
If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Union(Range("A3:A30"), Range("B3:B30"), Range("AA3:AA30"))) Is Nothing And Target <> vbNullString Then ' Change to Validated cell
        Set rngTemp = Nothing
        Select Case UCase(Mid(Target.Address, 2, InStr(2, Target.Address, "$") - 2))
            Case "A"
                Set rngTemp = [Fruit]
            Case "B"
                Set rngTemp = [Nam]
            Case "C"
           
        End Select
        If rngTemp Is Nothing Then Exit Sub
           
        If WorksheetFunction.CountIf(rngTemp, Target) = 0 Then 'New Name
        Application.EnableEvents = False 'Prevent Change Event Firing again while code is running.
          'Ask if they wish to add the name or not.
          iReply = MsgBox("The name " & Target & _
                  " is not part of the list, do you wish to add it.", _
                    vbYesNoCancel + vbQuestion, "New Fruits")
            If iReply = vbCancel Then 'Cancelled so restore orginal text
              Target = strOriginalEntry
            ElseIf iReply = vbNo Then
            'Don't add to list. That is do nothing
            Else 'Add the new name to the cell below the last name in the named range "Names"
                rngTemp.Cells(1, 1).End(xlDown)(2, 1) = Target
            End If
      End If
    End If
    Application.EnableEvents = True 'Allow Events
End Sub
 

Attachments

  • DDV-12644-75199.xlsm
    21.5 KB · Views: 3
Back
Top