changing the color of a cell for invalid values while copy/paste on a cell with "Data Validation"

[jt5721704]

Hello

I created a list data validation to a range of cells using =INDIRECT(SUBSTITUTE($D3," ","_")), and it works great, I do understand that there is a limitation that data validation only works with user enter values, however I need to populate the range with a Copy/Paste, so what I need, if possible, for a way that when I paste values I could flag, by changing the color of the cell, the invalid values pasted so the user will know that a new value is required to be selected from the drop down list.

If you have any ideas please share?

Thanks

 

[pbornemeier]

Your FileUploadTemplate worksheet has 17159947633 cells that contain data validation.
I doubt that was your intent

Put this code in a standard module:

Sub DisplayWorksheetSheetDVCellCount()
    
    Dim sOutput As String
    Dim lX As Long
    Dim varCountLarge As Variant
    
    For lX = 1 To Worksheets.count
        On Error Resume Next
        varCountLarge = Worksheets(lX).Cells.SpecialCells(xlCellTypeAllValidation).CountLarge
        If Err.Number <> 0 Then
            varCountLarge = 0
        Else
            varCountLarge = Worksheets(lX).Cells.SpecialCells(xlCellTypeAllValidation).CountLarge
        End If
        Err.Clear
        sOutput = sOutput & Worksheets(lX).Name & " has " & Format(varCountLarge, "#,##0") & " cells with data validation" & vbLf
    Next
    MsgBox sOutput, , "Cell Data Valiation Count"
End Sub

If you convert that page to a table the validation placed in the initial row will be copied to additional rows as they are added.

Remove the previously provided code

Put this code on the FileUploadTemplate codepage it will only check data validation as follows:
Column C cell with data validation, C, D, E in same row will be checked
Column D cell with data validation, D, E in same row will be checked
Column E cell with data validation, E in same row will be checked

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngCell As Range
    Dim lX As Long
    Dim lNumberOtherColumnsToCheck As Long
    If Not Intersect(Target, ActiveSheet.Cells.SpecialCells(xlCellTypeAllValidation), Range("3:5")) Is Nothing Then
        For Each rngCell In Intersect(Target, ActiveSheet.Cells.SpecialCells(xlCellTypeAllValidation))
            'Check each cell changed, and the two cells to its right
            Select Case rngCell.Column
            Case 3: lNumberOtherColumnsToCheck = 2 'Column C changed, also check D and E
            Case 4: lNumberOtherColumnsToCheck = 1 'Column D changed, also E
            Case 5: lNumberOtherColumnsToCheck = 0 'Column E changed, don't check any others
            Case Else: lNumberOtherColumnsToCheck = -1 'Don't check other columns
            End Select
            For lX = 0 To lNumberOtherColumnsToCheck
                CheckCellValueVsCellListValidation rngCell.Offset(0, lX)
            Next
        Next
    End If
End Sub

Put this code in a standard module:

Option Explicit

Sub CheckCellValueVsCellListValidation(rngCell As Range)
    'Ensure rngCell has validation applied, range with no validation will cause error
    'Turn cell yellow if it has validation, but the current value is not valid
    Dim lX As Long
    Dim lCellCount As Long
    Dim bFound As Boolean
    Dim varList As Variant
    
    If rngCell.Validation.Type = 3 Then
        Debug.Print "Checking " & rngCell.Address 'Comment out after testing
        'List Validation
        On Error Resume Next
        lCellCount = Range(Mid(rngCell.Validation.Formula1, 2)).Cells.Count
        On Error GoTo 0
        rngCell.Interior.Color = -4142
        If InStr(rngCell.Validation.Formula1, ",") > 0 And lCellCount = 0 Then
            'List specified explicitly
            varList = Split(rngCell.Validation.Formula1, ",")
            For lX = LBound(varList) To UBound(varList)
                If Trim(CStr(rngCell.Value2)) = Trim(CStr(varList(lX))) Then
                    bFound = True
                    Exit For
                End If
            Next
        Else
            'List specified by Named Range or Explicit Range
            lCellCount = Range(Mid(rngCell.Validation.Formula1, 2)).Cells.Count
            For lX = 1 To lCellCount
                If rngCell.Value2 = Range(Mid(rngCell.Validation.Formula1, 2)).Cells(lX) Then
                    'Formula1 looks like =NamedRange or =$AX$1:AX$12
                    bFound = True
                    Exit For
                End If
            Next
        End If
        If Not bFound Then
            rngCell.Interior.Color = vbYellow
        End If
        
    End If
End Sub

It did not appear as if the other DV columns (H:J & L:N) needed this treatment. If they did, please specify what needs to be checked when.

 

[jt5721704]

Phil

Thank you so much, I just did most of the changes and it looks like it is working. I will do more testing but wanted to let you know.

The only issue or a "Nice to have" is when I change a value because it is not in the list the cell stay "Yellow"

I will follow your suggestion about the table.

Thanks again

 

[pbornemeier]

Comment out/remove this line:
rngCell.Interior.Color = -4142
and cells will not change to No Color once turned yellow