Home

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

Dustin_1468
New Contributor

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 Replies

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

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
found
lDuplicates = 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

 

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
Related Conversations
Tabs and Dark Mode
cjc2112 in Discussions on
16 Replies
Stable version of Edge insider browser
HotCakeX in Discussions on
35 Replies
flashing a white screen while open new tab
cntvertex in Discussions on
11 Replies
How to Prevent Teams from Auto-Launch
chenrylee in Microsoft Teams on
28 Replies