Data Validation - To Stop the User Inputting more than one Specified Value in a column

[JohnGow383]

Hi. I have a question about data validation. Is there a way to remove one of the strings from data validation list if it's already been used in a row above in the specified range?
A quick example of what I mean. Lets's say in column A1:A30 each cell has a data validation list of 'A', 'B', 'C', 'D' and 'E'. Each of these options are available to be selected in any cell in range A1:A30.
I want A, B and C to be allowed to be selected multiple times like normal, however, with options D and E, I want these to be exclusive. So if A, B or C are in A1 to A10 and repeat multiple times that's fine. However, if for example D is selected in A11, the in A12 to A30 D is no longer available. The same would then apply to E. Basically, A to C to be inclusive and be selected multiple times (normal data validation list), but D or E are one times only.
VBA solution is welcome if it can't be done within Excel. If this can't be done I'd like to know too.
Thanks

 

[JoeMo]

If you want to be able to select any of A,B,C,D,E in any cell in A1:A30 using a DV dropdown, then VBA will be needed to ensure that D or E cannot be selected for more than one cell each in A1:A30.

 

[JohnGow383]

Thanks

If you want to be able to select any of A,B,C,D,E in any cell in A1:A30 using a DV dropdown, then VBA will be needed to ensure that D or E cannot be selected for more than one cell each in A1:A30.

I have the drop down already but I'm unsure about the VBA bit. Any idea?

 

[JoeMo]

Sure try this after you install it as a sheet event module in the sheet of interest. It should run automatically whenever a change is made to any cell in Range A1:A30.
To install sheet code:
1. Right-click the worksheet tab you want to apply it to and choose 'View Code'. This will open the VBE window.
2. Copy the code below from your browser window and paste it into the white space in the VBE window.
3. Close the VBE window and Save the workbook. If you are using Excel 2007 or a later version do a SaveAs and save it as a macro-enabled workbook (.xlsm file extension).
4. Make sure you have enabled macros whenever you open the file or the code will not run.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target, Range("A1:A30")) Is Nothing Then
    For Each c In Intersect(Target, Range("A1:A30"))
        If c.Value = "D" Or c.Value = "E" Then
            If WorksheetFunction.CountIf(Range("A1:A30"), c.Value) > 1 Then
                Application.EnableEvents = False
                Application.Undo
                MsgBox "Only one cell in the range A1:A30 can contain a ""D"" and similarly for ""E"""
                Application.EnableEvents = True
            End If
        End If
    Next c
End If
End Sub

 

[JohnGow383]

Hi. Thanks

Dim c As Range If Not Intersect(Target, Range("A1:A30")) Is Nothing Then For Each c In Intersect(Target, Range("A1:A30")) If c.Value = "D" Or c.Value = "E" Then If WorksheetFunction.CountIf(Range("A1:A30"), c.Value) > 1 Then Application.EnableEvents = False Application.Undo MsgBox "Only one cell in the range A1:A30 can contain a ""D"" and similarly for ""E""" Application.EnableEvents = True End If End If Next c End If

I changed it a little to match what I need, as the example I gave you was just an example. When I run it, it's giving an error. On debug the line Application.undo is showing yellow. Any ideas?
Here is the code:

Dim c As Range
Dim msg8 As String
msg8 = "You cannot have more than one SOP, ROP, SOP2 or ROP2 in a voyage!"

If Not Intersect(Target, Range("M4:M53")) Is Nothing Then
    For Each c In Intersect(Target, Range("M4:M53"))
        If c.Value = "SOP" Or c.Value = "ROP" Or c.Value = "SOP2" Or c.Value = "ROP2" Then
            If WorksheetFunction.CountIf(Range("M4:M53"), c.Value) > 1 Then
                Application.EnableEvents = False
                Application.Undo
                MsgBox msg8
                Application.EnableEvents = True
            End If
        End If
    Next c
End If

 

[JohnGow383]

Hi again. I tested it again on a blank ws and works fine. I have multiple Worksheet_change already in this sheet. One of them is also looking at this range but detecting when SOP, SOP2, ROP and ROP2 are the lowest value in the range to fire other macros. So I think, inserting this code into the top of the existing code is causing the issue. If i mirrored this column and used a hidden column as the trigger column would that work? As it would be using formula to mirror it then I doubt it. Perhaps using Worksheet_calculate() instead? Thanks anyway, it's very much appreciated.

Sure try this after you install it as a sheet event module in the sheet of interest. It should run automatically whenever a change is made to any cell in Range A1:A30.
To install sheet code:
1. Right-click the worksheet tab you want to apply it to and choose 'View Code'. This will open the VBE window.
2. Copy the code below from your browser window and paste it into the white space in the VBE window.
3. Close the VBE window and Save the workbook. If you are using Excel 2007 or a later version do a SaveAs and save it as a macro-enabled workbook (.xlsm file extension).
4. Make sure you have enabled macros whenever you open the file or the code will not run.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target, Range("A1:A30")) Is Nothing Then
    For Each c In Intersect(Target, Range("A1:A30"))
        If c.Value = "D" Or c.Value = "E" Then
            If WorksheetFunction.CountIf(Range("A1:A30"), c.Value) > 1 Then
                Application.EnableEvents = False
                Application.Undo
                MsgBox "Only one cell in the range A1:A30 can contain a ""D"" and similarly for ""E"""
                Application.EnableEvents = True
            End If
        End If
    Next c
End If
End Sub

 

[JoeMo]

Almost always a problem when the OP oversimplifies what you really want to do and fails to disclose things like existing change event code that requires a merging with solutions proposed by someone who is willing to spend their time for you. I don't understand what you mean by "If i mirrored this column and used a hidden column as the trigger column would that work?"

To go further, perhaps you could post a representative sample of your data using XL2BB and your existing event code.

 

[JohnGow383]

Almost always a problem when the OP oversimplifies what you really want to do and fails to disclose things like existing change event code that requires a merging with solutions proposed by someone who is willing to spend their time for you. I don't understand what you mean by "If i mirrored this column and used a hidden column as the trigger column would that work?"

To go further, perhaps you could post a representative sample of your data using XL2BB and your existing event code.

Yes i apologize for that. I'll be honest, it might not be with it being integrated as when I presses control z in the spreadsheet it didnt seem to be working. However, here is my original code. Thanks for taking a look.

Private Sub Worksheet_Change(ByVal Target As Range)

   Dim lrow As Integer
   
   'This gives warning if water consumption is high and tells user to give a reason.
    If Not Application.Intersect(Range("J3:J4"), Target) Is Nothing Then
        If Range("J3").Value > 15 And Range("J4").Value < 16 Then Call TalkDistilled
        If Range("J4").Value > 15 And Range("J3").Value < 16 Then Call TalkDomestic
        If Range("J3").Value > 15 And Range("J4").Value > 15 Then Call TalkDomDistHigh
                   
    ElseIf Not Application.Intersect(Range("M4:M53"), Target) Is Nothing Then
    
  'Clears some cells when the various cases are detected ie "NOON in PORT", "NOON in TRANS", "ROP", "ROP2"
        lrow = Cells(Rows.Count, "M").End(xlUp).Row
        If Target.Row = lrow Then
            Application.EnableEvents = False
            Select Case Target.Value
                Case "NOON in PORT", "NOON in TRANS", "ROP", "ROP2"
                    Range("I5,E4:F4,E5:F5").ClearContents
                Case Else
                    ' No Action Required
            End Select
                     
           'Calls comment macros when the below cases are detected.
           
            On Error Resume Next
                Range("D22").Comment.Delete
                Range("D23").Comment.Delete
                Range("D25").Comment.Delete
                Range("D26").Comment.Delete
            On Error GoTo 0
    
             Dim cmtCell As Range
            Select Case Target.Value
                Case "SOP"
                    Set cmtCell = Range("D22")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkSOP
                Case "ROP"
                    Set cmtCell = Range("D23")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkROP
                Case "SOP2"
                    Set cmtCell = Range("D25")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkSOP2
                Case "ROP2"
                    Set cmtCell = Range("D26")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkROP2
                Case "NOON in PORT"
                    Call TalkNOONinPORT
                Case "NOON at SEA"
                    Call TalkNOONatSEA
                Case "NOON in TRANS"
                    Call TalkNOONinTRANS
                Case "EOP"
                    Call TalkEOP
                Case "FAOP"
                    Call TalkFAOP
                    Case Else
                 ' Comment already deleted as initialisation step
            End Select
            
                         
            Range("j13").Select
            
            Application.EnableEvents = True
        End If
    End If
    
    'Speaks the duty eng name
    If Not Application.Intersect(Range("H12"), Target) Is Nothing Then
        If Range("H12").Value = "2nd Eng" Then Call Talk2E
        If Range("H12").Value = "3rd Eng" Then Call Talk3E
        If Range("H12").Value = "4th Eng" Then Call Talk4E
        If Range("H12").Value = "5th Eng" Then Call Talk5E
        If Range("H12").Value = "x-2/E" Then Call TalkX2E
        If Range("H12").Value = "x-3/E" Then Call TalkX3E
        If Range("H12").Value = "x-4/E" Then Call TalkX4E
    End If

    'ER temperature plus warning if hot
    If Not Application.Intersect(Range("E14"), Target) Is Nothing Then
        If Range("E14").Value <= 41 And Range("E14") > 0 Then Call ERtemp
        If Range("E14").Value > 41 Then Call ERtempWarning
                
     End If
    'Fuel Select
    If Not Application.Intersect(Range("J17"), Target) Is Nothing Then
        If Range("J17").Value = "LSFO" Then Call TalkLSFO
        If Range("J17").Value = "LSMGO" Then Call TalkLSMGO
     End If
    
    'Daily sludge
    If Not Application.Intersect(Range("I10"), Target) Is Nothing Then Call TalkSludgeLog
    
    'Detects FAOP and copies M/T counter to E7 when a change is detected in C4 and only when M4 is empty (i.e. at FAOP)
    'Detects SOP,ROP,SOP2 or ROP2 and when a change is detected in C4 copies and pastes the counter into the relevent cell
    Dim cell8 As Range
    Dim cell9 As Range
    Set cell8 = Range("M4")
    Set cell9 = Range("I24")
    
    If Not Application.Intersect(Range("C4"), Target) Is Nothing Then
        If IsEmpty(cell8) Then Call CopyMTCtratFAOP
        If cell9.Value = "SOP" Then Call CopyMTCtratSOP
        If cell9.Value = "ROP" Then Call CopyMTCtratROP
        If cell9.Value = "SOP2" Then Call CopyMTCtratSOP2
        If cell9.Value = "ROP2" Then Call CopyMTCtratROP2
    End If
         
End Sub

 

[JohnGow383]

What I meant by mirroring, was having say column Z = what is entered into column M but I don't think that would work.

Almost always a problem when the OP oversimplifies what you really want to do and fails to disclose things like existing change event code that requires a merging with solutions proposed by someone who is willing to spend their time for you. I don't understand what you mean by "If i mirrored this column and used a hidden column as the trigger column would that work?"

To go further, perhaps you could post a representative sample of your data using XL2BB and your existing event code.

 

[JoeMo]

What I meant by mirroring, was having say column Z = what is entered into column M but I don't think that would work.

I don't think it would either. After glancing at the code you posted I think you would have to provide a lot more detail about what you want a merged change event macro to do with some representative data posted with XL2BB.