[RESOLVED] Data Validation should be added when the user enter a value in a range of cells

[ammu]

Dear All,

Currently I am using the following macro which is working fine only for one column.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell As Range
    If Target.Column = 1 Then
        Set Cell = Target.Offset(0, 1)
        If Len(Target.Value) = 0 Then
            Cell.Validation.Delete
            Cell.Value = vbNullString
        Else
            If Target.Value <> " " Then
                With Cell.Vaidation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, Formula1:="=DatavalidationList1"
                End With
            ElseIf Target.Value = "" Then
                Cell.Validation.Delete
            Else
                MsgBox "Select only from the DropDown list"
                Target.ClearContents
                Cell.Validation.Delete
            End If
        End If
    End If
End Sub

I am attaching a sample workbook for your reference.

1) But now I have one more new scenario where I already have data validation in column A,but if user enters any value which is >0 in any of the columns D to H, then for that particular row cursor should go to column A and there should be a text message in RED saying "Please select from the drop down list..." and until user selects any one from the drop down list, cursor should not allow him/her to move anywhere in the worksheet (all other options should be disabled). User should not have a choice, but to select from the dropdown list.

2) Currently we have rows from 8 to 39, hence user may insert N number of rows after filling all 8 to 39 rows, then the above functions should work even for rows that were inserted newly. This should be dynamic

3) Also only for the following students "Rakesh, Mukesh, Pallavi, Manju and Keerthi" if we select their name in Column A, then in the same row column B, data validation list2 should be added and a text message in RED should appear saying "Please select from the drop down list..." and until user selects any one from the drop down list, cursor should not allow him/her to move anywhere in the worksheet (all other options should be disabled). User should not have a choice, but to select from the dropdown list.

Can someone please help me with this macro?


Best Regards
Amrutha

[ammu]

Can someone please help me on this?

[ammu]

Hi vbfbryce,

I have the following code which will help me up to some extent. Could you please help me to meet the specified criteria above?

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngInput As Range
    Dim rngTotal As Range
    Dim rngIntersect As Range
    Dim lgInputLastRowNum As Long

    Set rngTotal = Range("A:A").Find(what:="Total", LookAt:=xlPart, MatchCase:=False)

    If rngTotal Is Nothing Then
        MsgBox "No TOTAL found. Exit Sub"
        Exit Sub
    End If

    lgInputLastRowNum = rngTotal.row - 1

    Set rngInput = Range("D8:H" & lgInputLastRowNum)

    Set rngIntersect = Intersect(Target, rngInput)

    If Not rngIntersect Is Nothing Then
        For each cell in rngIntersect
            'Need your help here...
        Next cell
    End If

End Sub

[westconn1]

what is happening now? what specific problems are you having?

a text message in RED should appear saying "Please select from the drop down list..." and until user selects any one from the drop down list, cursor should not allow him/her to move anywhere in the worksheet

apart from not in red this is very close to the current operation, for all values in column A, easy enough to put a select case to limit the student criteria, to the listed names

to stop any move to other cell till data filled, you can try like

dim prev as range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not prev Is Nothing Then
    If prev.Column = 2 And IsEmpty(prev) Then
        On Error Resume Next
        v = prev.Validation.InCellDropdown
        If Err.Number = 0 Then
            prev.Select
            Exit Sub
            Else
            Err.Clear
        End If
        On Error GoTo 0
    End If
End If
Set prev = Target

End Sub

prev must be dimensioned as range in the general area at the top of the codepane

[vbfbryce]

Pete was quicker than me, but I was thinking of something very similar, like this:

Dim prevCell As Range

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet     '***
    Dim rngInput As Range
    Dim rngTotal As Range
    Dim rngIntersect As Range
    Dim lgInputLastRowNum As Long

    Set ws = ActiveSheet    '***
    Set rngTotal = ws.Range("A:A").Find(what:="Total", LookAt:=xlPart, MatchCase:=False)    '***

    If rngTotal Is Nothing Then
        MsgBox "No TOTAL found. Exit Sub"
        Exit Sub
    End If
    
    Set prevCell = ws.Range("a" & Target.Row)

    lgInputLastRowNum = rngTotal.Row - 1

    Set rngInput = ws.Range("D8:H" & lgInputLastRowNum) '***

    Set rngIntersect = Intersect(Target, rngInput)

    If Not rngIntersect Is Nothing Then
        If Target.Value > 0 Then
            If ws.Range("a" & Target.Row).Value = "" Then
                MsgBox "Please select from the dropdown list in cell A" & Target.Row, vbCritical
                ws.Range("a" & Target.Row).Select
            End If
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not prevCell Is Nothing Then
        If prevCell.Value = "" Then
            prevCell.Select
        End If
    End If
End Sub

[ammu]

Hi Vbfbryce,

It is working very fine till row 39, users might insert more rows (between 8 to 39 rows) they insert 1 row or 10 rows at a time in that case it is not working and I am getting type mismatch error. Is it possible to extend this code to newly inserted rows as well? Since the number of rows are dynamic

Kind Regards
Amrutha

[vbfbryce]

Updated:

Dim prevCell As Range

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet     '***
    Dim rngInput As Range
    Dim rngTotal As Range
    Dim rngIntersect As Range
    Dim lgInputLastRowNum As Long

    Set ws = ActiveSheet    '***
    Set rngTotal = ws.Range("A:A").Find(what:="Total", LookAt:=xlPart, MatchCase:=False)    '***

    If rngTotal Is Nothing Then
        MsgBox "No TOTAL found. Exit Sub"
        Exit Sub
    End If


    lgInputLastRowNum = rngTotal.Row - 1

    Set rngInput = ws.Range("D8:H" & lgInputLastRowNum) '***

    Set rngIntersect = Intersect(Target, rngInput)
    If Target.Columns.Count = 1 Then    'ensure the "change" was not due to inserting row(s) *************
        Set prevCell = ws.Range("a" & Target.Row)   'moved this here *************************************
        If Not rngIntersect Is Nothing Then
            If Target.Value > 0 Then
                If ws.Range("a" & Target.Row).Value = "" Then
                    MsgBox "Please select from the dropdown list in cell A" & Target.Row, vbCritical
                    ws.Range("a" & Target.Row).Select
                End If
            End If
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not prevCell Is Nothing Then
        If prevCell.Value = "" Then
            prevCell.Select
        End If
    End If
End Sub

[ammu]

Excellent work vbfbryce. You're the best. I have no words to express my feelings. Thank you once again for your help

[vbfbryce]

You're welcome! (but don't forget about Pete!)

[ammu]

No. No vbfbryce. I am using his code to fulfil my criteria 3 in question #1.

Hi Pete,
Thank you so much for all your support in the forum. You guys rock

[westconn1]

forgot, i stuck cells.select in your posted code

            If Target.Value <> " " Then
                With Cell.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, Formula1:="=DatavalidationList2"
                End With
                Cell.Select

i have not read bryces code and it may cover this anyway, stopped the user going to other cell after selecting in col A

[ammu]

Here is the code that I am using currently. Everything is working fine as expected, but there are two small things that need to be fixed.

Dim prevCell As Range
Dim PrevCell1 As Range


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet     '***
    Dim Cell As Range
    Dim rngInput As Range
    Dim rngTotal As Range
    Dim rngIntersect As Range
    Dim lgInputLastRowNum As Long

    Set ws = ActiveSheet    '***
    Set rngTotal = ws.Range("A:A").Find(what:="Total", LookAt:=xlPart, MatchCase:=False)    '***
    
    Set PrevCell1 = ws.Range("b" & Target.Row)
    
    If Target.Column = 1 Then
        Set Cell = Target.Offset(0, 1)
        If Len(Target.Value) = 0 Then
            Cell.Validation.Delete
            Cell.Value = vbNullString
        Else
            If Target.Value = "Rakesh" Then
                With Cell.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, Formula1:="=Datavalidationlist2"
                    MsgBox "Please select 'Student Code' from the dropdown list in cell B" & Target.Row, vbCritical
                    ws.Range("b" & Target.Row).Select
                End With

            ElseIf Target.Value = "Mukesh" Then
                With Cell.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, Formula1:="=Datavalidationlist2"
                    MsgBox "Please select 'Student Code' from the dropdown list in cell B" & Target.Row, vbCritical
                    ws.Range("b" & Target.Row).Select
                End With

             ElseIf Target.Value = "Pallavi" Then
                With Cell.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, Formula1:="=Datavalidationlist2"
                    MsgBox "Please select 'Student Code' from the dropdown list in cell B" & Target.Row, vbCritical
                    ws.Range("b" & Target.Row).Select
                End With

            ElseIf Target.Value = “Manju" Then
                With Cell.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, Formula1:="=Datavalidationlist2"
                    MsgBox "Please select 'Student Code' from the dropdown list in cell B" & Target.Row, vbCritical
                    ws.Range("b" & Target.Row).Select
                End With

            ElseIf Target.Value = "Keerthi" Then
                With Cell.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                    Operator:=xlBetween, Formula1:="=Datavalidationlist2"
                    MsgBox "Please select 'Student Code' from the dropdown list in cell B" & Target.Row, vbCritical
                    ws.Range("b" & Target.Row).Select
                End With
            End If
        End If
    End If
    
    If rngTotal Is Nothing Then
        MsgBox "No TOTAL found. Exit Sub"
        Exit Sub
    End If


    lgInputLastRowNum = rngTotal.Row - 1

    Set rngInput = ws.Range("G16:K" & lgInputLastRowNum) '***

    If Target.Columns.Count = 1 Then    'ensure the "change" was not due to inserting row(s) *************
        Set prevCell = ws.Range("a" & Target.Row)   'moved this here *************************************
        Set rngIntersect = Intersect(Target, rngInput)
        
        If Not rngIntersect Is Nothing Then
        End If
    
    If Target.Value > 0 Then
        If ws.Range("a" & Target.Row).Value = "" Then
              MsgBox "Please select 'Student Name' from the dropdown list in cell A" & Target.Row, vbCritical
              ws.Range("a" & Target.Row).Select
        End If
    End If
    
    End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not prevCell Is Nothing Then
        If prevCell.Value = "" Then
            prevCell.Select
        End If
    End If
    
    If Not PrevCell1 Is Nothing Then
        If PrevCell1.Value = "" Then
            PrevCell1.Select
        End If
    End If
End Sub

1) If user enters data or value any where in the worksheet, it is asking user to select Column A value. It should ask only when the user enters a value in a cell range D8 to H last row only

2) also macro is selecting column B and forcing user to select Column B for all names which are there in column A dropdown list and not allowing user to select anywhere in the worksheet. In normal scenario, macro should select column B only when the user selects the names that were specified in criteria 3 in question no 1. Only in that case, macro should force the user to select Column B. Is this possible?

[westconn1]

how many names in the real list?
for the number in the example a select case would work ok, but if a big list maybe some worksheet function

[ammu]

how many names in the real list?
for the number in the example a select case would work ok, but if a big list maybe some worksheet function

There are only 8 names in the list

[westconn1]

try like

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cell As Range
    If Target.Column = 1 Then
        Set Cell = Target.Offset(0, 1)
        If Len(Target.Value) = 0 Then
            Cell.Validation.Delete
            Cell.Value = vbNullString
        Else
'            If Target.Value <> " " Then
            Select Case Target.Value
                Case "Rakesh", "Mukesh", "Pallavi", "Manju", "Keerthi"
                    With Cell.Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                        Operator:=xlBetween, Formula1:="=DatavalidationList2"
                    End With
                    Cell.Select
'            ElseIf Target.Value = "" Then
                Case vbNullString
                    Cell.Validation.Delete
'            Else
                Case Else
                    MsgBox "Select only from the DropDown list"
                    Target.ClearContents
                    Cell.Validation.Delete
'            End If
            End Select
        End If
    End If

End Sub

[ammu]

Hi Pete,

Thank you so much. I have removed my code (colored in blue) which is there in #12 and used this one. Thank you once again.

One last help Pete. You can see in #12, I Have colored some code in Red. This RED code is currently forcing user to select column B text for all names in column A, but it should force the user to select Column B text only when the following names "Rakesh", "Mukesh", "Pallavi", "Manju", "Keerthi" in Column A are selected. So that user has to select column B text and without selecting column B text, macro should not allow him/her to leave that cell. Please help me with this one.

Kind Regards
Amrutha

[westconn1]

the sample i posted in #4 should work like that anyway

[ammu]

Thanks Pete. I tried something different and which worked fine. Here is the code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If PrevCell = "Rakesh" Or PrevCell = "Mukesh" Or PrevCell = "Pallavi" Or PrevCell = "Manju" Or PrevCell = "Keerthi" Then

    If Not PrevCell1 = "Rakesh" Or PrevCell1 = "Mukesh" Or PrevCell1 = "Pallavi" Or PrevCell1 = "Manju" Or PrevCell1 = "Keerthi" Then

            If PrevCell1.Value = "" Then
                PrevCell1.Select
            End If
        End If
    End If

End Sub

[westconn1]

another select case would be better than all the or ifs

[ammu]

Thanks for the suggestion Pete. I will use select case. Thank you once again for all your help