where do i go from here?

[Rivie]

so far this is the code i have:
Private Sub Worksheet_Change_C(ByVal Target As Range)
If Target.Row = 1 Then Exit Sub
On Error GoTo ErrHandler
Application.ScreenUpdating = False

Dim myDataRng As Range
Dim cell As Range
Set myDataRng = Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)

For Each cell In myDataRng
cell.Offset(0, 0).Font.Color = vbBlack

If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
cell.Offset(0, 0).Font.Color = vbRed
End If
Next cell

Set myDataRng = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

i need the code to check column F to see if a corresponding cell is true or false or i need it to check the next duplicate range to see if the cells exactly match. basically if the b column if a duplicate i need it to see if 2 cells to the right has a date input and if it does then the duplicate is not a true duplicate to not turn it red. i'm not even sure if this is possible

 

[Lee J]

Hi Rivie,

Could you not do this with conditional formatting?

 

[Rivie]

Hi Rivie,

Could you not do this with conditional formatting?

View attachment 19369

I thought of doing that first but i have several conditions that need to be met for it to flag a duplication. its more then just if 50 shows up twice. its if 50 shows up twice does it have a sign in date attached to one of them if so then they are not true duplicates.

 

[MARK858]

So which do you need?

i need the code to check column F to see if a corresponding cell is true or false

or

basically if the b column if a duplicate i need it to see if 2 cells to the right has a date input

If the 2nd one, what is in the cells if there isn't a date input?

I assume that the below is working correctly for picking the duplicates if you are ignoring the new condition?

If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1

 

[Rivie]

So which do you need?

or

If the 2nd one, what is in the cells if there isn't a date input?

I assume that the below is working correctly for picking the duplicates if you are ignoring the new condition?

If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1

i think that the second option is something that would work better if it is do-able. if there is no date in the cell 2 over it is just blank. the if code you listed above is working.

 

[MARK858]

Then it looks like all that you need is

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row = 1 Then Exit Sub
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    Dim myDataRng As Range
    Dim cell As Range
    Set myDataRng = Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)

    For Each cell In myDataRng
        cell.Font.Color = vbBlack

        If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 And cell.Offset(, 2) = "" Then
            cell.Font.Color = vbRed
        End If
    Next cell

    Set myDataRng = Nothing
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Not sure why you are setting Application.EnableEvents = True when you haven't set it to False not that it does any harm.

More importantly your code will fire if you change any cell on the sheet except row 1 as you aren't setting a target range (or would if you didn't have the _C at the end of Worksheet_Change_C) is that what you want?

 

[Rivie]

Then it looks like all that you need is

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row = 1 Then Exit Sub
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    Dim myDataRng As Range
    Dim cell As Range
    Set myDataRng = Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)

    For Each cell In myDataRng
        cell.Font.Color = vbBlack

        If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 And cell.Offset(, 2) = "" Then
            cell.Font.Color = vbRed
        End If
    Next cell

    Set myDataRng = Nothing
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Not sure why you are setting Application.EnableEvents = True when you haven't set it to False not that it does any harm.

More importantly your code will fire if you change any cell on the sheet except row 1 as you aren't setting a target range (or would if you didn't have the _C at the end of Worksheet_Change_C) is that what you want?

I'm honestly really new to this program so i did not know that i could just set it to false. i need the code to check whenever i have row with a new entry. I have attached a pic of the sheet i'm using, i do not know if that wood help.

 

[MARK858]

How is the macro supposed to be triggered? by a change to a cell in column B or some other means?

 

[Rivie]

How is the macro supposed to be triggered? by a change to a cell in column B or some other means?

yes a change to column B

 

[MARK858]

See if the below is doing what you want..

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myDataRng As Range, myCell As Range
    If Target.Row = 1 Or Target.CountLarge > 1 Then Exit Sub

    Set myDataRng = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    Application.ScreenUpdating = False

    If Not Intersect(Target, myDataRng) Is Nothing Then
        Application.EnableEvents = False

        myDataRng.Font.Color = vbBlack

        For Each myCell In myDataRng
            If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & myCell.Address & ")") > 1 And _
            myCell.Offset(, 2) = "" Then myCell.Font.Color = vbRed
        Next myCell

        Set myDataRng = Nothing

        Application.EnableEvents = True
    End If

    Application.ScreenUpdating = True
End Sub