Data Validation in VBA Code

hajiali

Board Regular
Joined
Sep 8, 2018
Messages
171
hello yall Im tring to do a DV in VBA code where if A1=Yes then value in D1 must be between 1-120 and if value in A1=No then value in D1 must be between 121 - 150

Im thinking I need a DV in VBA Code. I already have a DV for D1 so I prefer a VBA.

Any suggestion is greatly appreciative.


Thanks
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,984
Office Version
365
Platform
Windows
I know you said you wanted VBA but here is a way to do it with DV in cell D1

ALLOW: Custom
DV Formula:
=IF(A1="yes",AND(D1>0,D1<121),IF(A1="no",AND(D1>120,D1<151)))

Note
- if you already have DV in cell D1 we need to know what it is to get the VBA correct
- it implies that the conditions in the original DV are different
- if so what are those conditions? and what shoul happen if they conflict with your "yes" "no" ?
- is there a risk that current DV prevents values from 1 to 151 being accepted in the cell thus making it impossible for your requested VBA to kick in?
 
Last edited:

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,984
Office Version
365
Platform
Windows
VBA as requested
- also read what I wrote in post#2

Must put code in SHEET module
(right-click sheet tab \ View Code \ paste code into Code Window \ {ALT}{F11} to go back to Excel )

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A1     As Range: Set A1 = Range("A1")
    Dim D1     As Range: Set D1 = Range("D1")
    
    If Target.Address = D1.Address Then
        Application.EnableEvents = False
        Select Case A1
            Case "yes":     If D1 < 1 Or D1 > 120 Then D1.ClearContents
            Case "no":      If D1 < 121 Or D1 > 150 Then D1.ClearContents
        End Select
        Application.EnableEvents = True
    End If
End Sub


Above test is case sensitive
- so "YES" is not the same as "yes" or "Yes"

This would make the test case insensitive
Code:
Select Case LCase(A1)
 
Last edited:

hajiali

Board Regular
Joined
Sep 8, 2018
Messages
171
Thanks for the Reply Yongle and sorry for this late reply: The reason I needed the VBA is so I can do a Different message when the cell in a Yes and No when they input is not with in the range that I should be.

thanks I will give this Try


VBA as requested
- also read what I wrote in post#2

Must put code in SHEET module
(right-click sheet tab \ View Code \ paste code into Code Window \ {ALT}{F11} to go back to Excel )

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A1     As Range: Set A1 = Range("A1")
    Dim D1     As Range: Set D1 = Range("D1")
    
    If Target.Address = D1.Address Then
        Application.EnableEvents = False
        Select Case A1
            Case "yes":     If D1 < 1 Or D1 > 120 Then D1.ClearContents
            Case "no":      If D1 < 121 Or D1 > 150 Then D1.ClearContents
        End Select
        Application.EnableEvents = True
    End If
End Sub


Above test is case sensitive
- so "YES" is not the same as "yes" or "Yes"

This would make the test case insensitive
Code:
Select Case LCase(A1)
 

hajiali

Board Regular
Joined
Sep 8, 2018
Messages
171
The code works great. However, is there a way to have excel apply msgbox

when A1: YES and a value 121 or greater is type in D1

MsgBox "The value entered dose not meet the requirement Please select a Value lower than 120", vbCritical, "Error"

AND

when A1: NO and a value less than 121 is type in D1

have excel MsgBox "The value entered dose not meet the requirement Please select a value 121 or higher", vbCritical, "Error"

Also, With this code could I use Range Say if I wanted to Apply this to A1:A120 and D1:D120 Where D1 check value of A1, D2 checks Value of A2 etc....

Thanks for Your Help
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,984
Office Version
365
Platform
Windows
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D1:D120")) Is Nothing Then
        Dim D       As Range: Set D = Target
        Dim A       As Range: Set A = D.Offset(, -3)
        Application.EnableEvents = False
        Select Case A
            Case "yes"
               [COLOR=#008080] If D < 1 Or D > 120 Then[/COLOR]
                    D.ClearContents
                    MsgBox "The value entered does not meet the requirement Please select a Value 120 or lower", vbCritical, "Error"
                    Target.Select
                End If
            Case "no"
               [COLOR=#ff0000] If D < 121 Or D > 150 Then[/COLOR]
                    D.ClearContents
                    MsgBox "The value entered does not meet the requirement Please select a value 121 or higher", vbCritical, "Error"
                    Target.Select
                End If
        End Select
        Application.EnableEvents = True
    End If
End Sub

If user is selecting from dropdown with values 1 to 150 then you can use these 2 simpler tests
Code:
[COLOR=#008080] If D > 120 Then  [/COLOR]

[COLOR=#ff0000] If D < 121 Then[/COLOR]
 
Last edited:

hajiali

Board Regular
Joined
Sep 8, 2018
Messages
171
Not sure why but the code below is not working. Not only the Message does not appear but its also not Recognize the Value in A1 of "Yes" and "No" its allowing me to type any value in D column regardless whats in A column. so the D.ClearContents is not active nor the msgbox

The First code the D.clearcontents was working where based on the value in cell A2


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D1:D120")) Is Nothing Then
        Dim D       As Range: Set D = Target
        Dim A       As Range: Set A = D.Offset(, -3)
        Application.EnableEvents = False
        Select Case A
            Case "yes"
               [COLOR=#008080] If D < 1 Or D > 120 Then[/COLOR]
                    D.ClearContents
                    MsgBox "The value entered does not meet the requirement Please select a Value 120 or lower", vbCritical, "Error"
                    Target.Select
                End If
            Case "no"
               [COLOR=#ff0000] If D < 121 Or D > 150 Then[/COLOR]
                    D.ClearContents
                    MsgBox "The value entered does not meet the requirement Please select a value 121 or higher", vbCritical, "Error"
                    Target.Select
                End If
        End Select
        Application.EnableEvents = True
    End If
End Sub

If user is selecting from dropdown with values 1 to 150 then you can use these 2 simpler tests
Code:
[COLOR=#008080] If D > 120 Then  [/COLOR]

[COLOR=#ff0000] If D < 121 Then[/COLOR]
 
Last edited:

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,984
Office Version
365
Platform
Windows
That surprises me - I tested the code before posting it. I will test it again (just in case!) when I get back to PC
Is there any other code in the sheet module?
Is the data validation just a list of numbers 1 to 150?

in the meantime, please test again by creating a new sheet, adding the code to its sheet module, and add DV to a few cells in column D and test with "yes" and "no" in column A
(I am testing on a clean sheet, so best if you replicate)
thanks
 

hajiali

Board Regular
Joined
Sep 8, 2018
Messages
171
Yes there is

I have the code Below Is when Column in T2 is YES it clears the the value in A3:A122,a124:a153 In the sheets specified.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)If Not Intersect(Target, [T2]) Is Nothing And UCase([T2]) = "YES" Then _ 
    Sheets("CSA1").Range("A3:A122,a124:a153").ClearContents
If Not Intersect(Target, [T3]) Is Nothing And UCase([T3]) = "YES" Then _
    Sheets("CSA2").Range("A3:A122,a124:a153").ClearContents
If Not Intersect(Target, [T4]) Is Nothing And UCase([T4]) = "YES" Then
    Sheets("CSA3").Range("A3:A122,a124:a153").ClearContents
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,984
Office Version
365
Platform
Windows
You cannot have 2 Worksheet change subs
In the same sheet - they must be combined into a single sub
If it is a single sub please post the whole sub
Thanks
 
Last edited:

Forum statistics

Threads
1,086,222
Messages
5,388,552
Members
402,121
Latest member
jgyurko

Some videos you may like

This Week's Hot Topics

Top