简体   繁体   中英

Excel VBA Data Validation on cell changed

I have a worksheet named Employees where I have a column named Department. I also have a worksheet named Departments where in column AI have all the departments available for Employees. I want to validate the Department column of Employees worksheet such as when I write a department in Department column of Employees worksheet, if the department is in Departments worksheet the font color remain the same (black), otherwise the font color change to blue.

This is what I have until now but I can't manage with the cell on change event.

Private Sub CommandButton1_Click()
    Dim i As Integer
    Dim j As Integer
    Dim aux As Integer
    Dim count As Integer

    For i = 2 To 301
        For j = 1 To 4
            If Sheet13.Range("H" & i).Value = Sheet14.Range("A" & j) Then
                aux = 1
                Exit For

            Else
                Sheet13.Range("H" & i).Font.ThemeColor = 5
            End If
        Next
        If aux = 1 Then
            Sheet13.Range("H" & i).Font.ThemeColor = 2
            aux = 0
        End If
    Next
End Sub

Try using something like this:

Private Sub Worksheet_Change(ByVal Target As Range)
dim rng as Range

set rng = Sheets(1).cells(1,1) ' Change this equal to the range you want to monitor

If Not Intersect(Target, rng) Is Nothing Then

' Place the code you want to run here

End If

End Sub

Remembering to place this in the worksheet code (not in a separate module)

I did some research and I managed to validate the data. Here is my code:

Dim o As Integer
Dim p As Integer
Dim aux As Integer
Dim count14 As Integer
Dim count13 As Integer
Dim KeyCells As Range
Set KeyCells = Range("A1:M301")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
       Is Nothing Then
    count13 = Sheet13.Cells(Rows.count, 8).End(xlUp).Row
    For o = 0 To count13 - 1
        count14 = Sheet14.Cells(Rows.count, 1).End(xlUp).Row
        For p = 1 To count14
            If Sheet13.Range("H" & (o + 2)).Value = Sheet14.Range("A" & p) Then
                aux = 1
                Exit For

            Else
                Sheet13.Range("H" & (o + 2)).Font.ThemeColor = 6
            End If
        Next
        If aux = 1 Then
            Sheet13.Range("H" & (o + 2)).Font.ThemeColor = 2
            aux = 0
        End If
    Next
End If

Hope it's helpful.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM