Help Searching data using form entry/last row, selecting matching criteria and modifying a value

[Dustin_1468]

I need to compare the data from an excel form to a column on the sheet that it enters data to, then if that same data is there change another cell for the already existing data to 0.

I have data that needs to be continuously logged NO erasing duplicates - Tracking dates of "Active".

I have a data entry form with Item, Date and 1 (1 is there to show it's active on this date). The form enters the data at the last Row / next empty row on "ItemData"Sheet.

$A="Item"    $B="Date"    $C="Active(1)"

  $A |    $B       | $C  
$1  I1 |  1-5-19  | 1 
$2  I2 |  1-8-19  | 1
$3  I3 |  1-9-19  | 1
$4  I1 |  1-9-19  | 1
$5  I4 |  1-9-19  | 1
$6  I2 |  1-10-19 | 1
$7  Next time submit button click data goes here

I need to - Form on "Submit" Button Click Compare "Item", "Date and "Active" in the Last entry, $7 in the example above, to all other entries on the sheet.

If the New entry ($7) "Item" $A is the same as any other entry in $A AND the "Date" ($B) is before the New Item Date ($B$7) and "Active" ($C) is also = 1 Then Change $C "Active" from 1 to 0 for the matched Item and leave New entry $C$7 = 1.

I know... Confusing right?!?

Basically take the example above. When I "Submit" on the form a new entry of:

    $A |    $B         | $C 
    $7  I1 |  1-11-19  | 1 

It should find All "I1" in $A with dates before "1-11-19" in $B and with "1" in $C. Then Change every "1" in $C for those entries to "0".

Example:

    $A |    $B       | $C  
    $1  I1 |  1-5-19  | 0 
  $2  I2 |  1-8-19  | 1
  $3  I3 |  1-9-19  | 1
  $4  I1 |  1-9-19  | 0
  $5  I4 |  1-9-19  | 1
  $6  I2 |  1-10-19 | 1
  $7  I1 |  1-11-19 | 1

Then of course the Next "Submit" on the form for another new entry of:

    $A |    $B        | $C  
   $8  I2 |  1-12-19  | 1 

It should find All "I2" in $A with dates before "1-12-19" in $B and with "1" in $C. Then Change every "1" in $C for those entries to "0".

Example:

    $A |    $B       | $C  
    $1  I1 |  1-5-19  | 0 
  $2  I2 |  1-8-19  | 0
  $3  I3 |  1-9-19  | 1
  $4  I1 |  1-9-19  | 0
  $5  I4 |  1-9-19  | 1
  $6  I2 |  1-10-19 | 0
  $7  I1 |  1-11-19 | 1
  $8  I2 |  1-12-19 | 1 

I have tried and failed so many different code attempts that it's embarrassing, so I can not submit "My Code" because I apparently don't know where to start. Please if anyone can help with this I'd really appreciate it!

[#2]

======================================================================

UPDATE

Ok, so I couldn't figure out how to do this with autofilter... But I've got a good foundation now! I still need some help modifying this.

I need a condition to only change the duplicates that have a date prior to the one in the form field "txtDate" or newest entry on the worksheet (last row column D).

Here is the current code:

Dim i As Long
Dim j As Long
Dim lDuplicates As Long
Dim rngCheck As Range
Dim rngCell As Range
Dim rngDuplicates() As Range

'Range
Set rngCheck = ws.Range("$A:$A")

'# of Duplicates 
foundlDuplicates = 0

'Checking cells in range
For Each rngCell In rngCheck.Cells
    Debug.Print rngCell.Address

'Check non empty cells only
    If Not IsEmpty(rngCell.Value) Then

     'Resize & clear duplicate array
        ReDim rngDuplicates(0 To 0)
     'Setting counter
        i = 0

      'Search method
        Set rngDuplicates(i) = rngCheck.Find(What:=rngCell.Value, After:=rngCell, LookIn:=xlValues, _
                                                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)

      'Check if duplicates exist
        If rngDuplicates(i).Address <> rngCell.Address Then

          'Count duplicates
            lDuplicates = lDuplicates + 1

          'If duplicates exsist then continue filling array
            Do While rngDuplicates(i).Address <> rngCell.Address
                i = i + 1
                ReDim Preserve rngDuplicates(0 To i)
                Set rngDuplicates(i) = rngCheck.FindNext(rngDuplicates(i - 1))
            Loop

          'Set the value of duplicates to 0 and number format to text
            For j = 0 To UBound(rngDuplicates, 1) - 1
                       rngDuplicates(j).Offset(0, 5).Value = "0"
                       rngDuplicates(j).Offset(0, 5).NumberFormat = "@"
            Next j
        End If
    End If
Next rngCell

[#3]

It's not pretty but it works!

Working Code:

Dim i As Long
Dim j As Long
Dim k As Long
Dim lConNbr As Long
Dim lConDate As Long
Dim lConYes As Long
Dim StartRow As Long
Dim LastRow As Long
Dim lVal1 As Long
Dim lVal2 As Date
Dim lVal3 As Long
Dim lDup As Long
Dim rngCheck As Range
Dim rngCell As Range
Dim rngDup() As Range

StartRow = 2

'Set Variable Names
lVal1 = Me.cboNbr.Value
lVal2 = Me.txtDate.Value
lVal3 = Me.txtYes.Value

'Set Check Range
Set rngCheck = ws.Range("$A:$A")

'Number of Duplicates Found
lDup = 0

'Checking each cell in range
For Each rngCell In rngCheck.Cells

     'Checking only non empty cells
     If Not IsEmpty(rngCell.Value) Then

          'Resizing and clearing duplicate array
          ReDim rngDup(0 To 0)

          'Setting counter to start
          i = 0

          'Starting search method
           Set rngDup(i) = rngCheck.Find(What:=rngCell.Value, LookIn:=xlValues, _
                           LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)

          'Check if at least one duplicate
          If rngDup(i).Address <> rngCell.Address Then

               'Counting duplicates
               lDup = lDup + 1

                         'If yes, continue filling array
                              Do While rngDup(i).Address <> rngCell.Address
                                   i = i + 1
                                   ReDim Preserve rngDup(0 To i)
                                   Set rngDup(i) = rngCheck.FindNext(rngDup(i - 1))
                         Loop

               For k = StartRow To lrow
                    lConNbr = ws.Range("A" & k).Value
                    lConDate = ws.Range("D" & k).Value
                    lConYes = ws.Range("F" & k).Value

                    'Make changes to duplicate cells
                    If lVal1 = lConNbr And lVal3 = lConYes Then
                         For j = 0 To UBound(rngDup, 1) - 1
                              rngDup(j).Offset(0, 5).NumberFormat = "@"
                              rngDup(j).Offset(0, 5).Value = "0"
                         Next j
                    End If
               Next k
          End If
     End If
Next rngCell