Programatically look for duplicates and rename data in a column if one found

[lridlen]

Hi,

I have a spreadsheet with a custom data entry form to control input of forecast numbers. When a user hits the 'add' button on the form, the data from the form is added to the bottom of the worksheet 'fdata'.

What I need to do when adding the data to the form, is check for previous duplicate entries with matching data in columns B, C, J and K and containing "TRUE" in Column F, if a duplicate is found I need to change 'TRUE' to 'FALSE' in column F.

My code looks like this so far, so I need to add this check/change at the end:-

Private Sub Add1_Click()
Dim lRow As Long
Dim lIntModel As Long
Dim ws As Worksheet
Set ws = Worksheets("FData")

lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1


'copy the data to the database
With ws
.Cells(lRow, 1).Value = Me.cboMod1.Value
.Cells(lRow, 2).Value = Me.cboYear.Value
.Cells(lRow, 3).Value = Me.cboMonth.Value
.Cells(lRow, 4).Value = Me.cboFor1.Value
.Cells(lRow, 5).Value = Now()
.Cells(lRow, 6).Value = "TRUE"
.Cells(lRow, 7).Value = Me.cboAuthor.Value
.Cells(lRow, 8).Value = Me.cboReason.Value
.Cells(lRow, 9).Value = Me.cboCategory.Value
.Cells(lRow, 11).Value = Me.cboSen1
.Cells(lRow, 13).Value = Now()
End With

MsgBox "Model Forecast has been added"

End Sub

Can anyone help me with some code to do this.

Spreadsheet attached.

Thanks,
Louise

[nathansav]

You could use this function

Please Login or Register  to view this content.

Which you would call from the code passing the data back to the sheet, something like this

Please Login or Register  to view this content.

That is searcing for a 1 in each column, you would need to change the "1" to be the form control values and change the sheet name from Sheet1

[lridlen]

Hi,

Thanks so much for your reply.

I've added in your suggestions with the changes to sheet name and form controls but I get an error on this line:-

.Cells(lRow, 6).Value = "TRUE"

I get compile error: Invalid or unqualified reference.

That doesn't make sense to me since it's already working further up in the code. So this is what my code looks like now:-


Private Sub Add1_Click()
Dim lRow As Long
Dim lIntModel As Long
Dim ws As Worksheet
Set ws = Worksheets("FData")

lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'copy the data to the database
With ws
.Cells(lRow, 1).Value = Me.cboMod1.Value
.Cells(lRow, 2).Value = Me.cboYear.Value
.Cells(lRow, 3).Value = Me.cboMonth.Value
.Cells(lRow, 4).Value = Me.cboFor1.Value
.Cells(lRow, 5).Value = Now()
.Cells(lRow, 6).Value = "TRUE"
.Cells(lRow, 7).Value = Me.cboAuthor.Value
.Cells(lRow, 8).Value = Me.cboReason.Value
.Cells(lRow, 9).Value = Me.cboCategory.Value
.Cells(lRow, 10).Value = Me.FMonth.Value
.Cells(lRow, 11).Value = Me.cboSen1
.Cells(lRow, 13).Value = Now()
End With

If (Is_Present(2, Me.cboYear) Or Is_Present(3, Me.cboMonth) Or Is_Present(10, Me.FMonth) Or Is_Present(11, Me.cboSen1)) Then
.Cells(lRow, 6).Value = "TRUE"
Else
.Cells(lRow, 6).Value = "FALSE"
End If

[lridlen]

Hello again,

I sorted out the last issue by moving the End With to the end of the code - should have picked that up earlier, sorry!

However, it's still not recognising up any duplicates in the range at all, it's skipping to the Else statement each time and adding the value as 'false' regardless of the fact that I've just added three duplicate rows above the data entry row. I have tried changing the references from the form control values back to the actual numbers I'm looking for just to make sure it's not empty references, and still nothing.

now looks like this:-

Private Sub Add1_Click()
Dim lRow As Long
Dim lIntModel As Long
Dim ws As Worksheet
Set ws = Worksheets("FData")

lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'copy the data to the database
With ws
.Cells(lRow, 1).Value = Me.cboMod1.Value
.Cells(lRow, 2).Value = Me.cboYear.Value
.Cells(lRow, 3).Value = Me.cboMonth.Value
.Cells(lRow, 4).Value = Me.cboFor1.Value
.Cells(lRow, 5).Value = Now()
.Cells(lRow, 6).Value = "TRUE"
.Cells(lRow, 7).Value = Me.cboAuthor.Value
.Cells(lRow, 8).Value = Me.cboReason.Value
.Cells(lRow, 9).Value = Me.cboCategory.Value
.Cells(lRow, 10).Value = Me.FMonth.Value
.Cells(lRow, 11).Value = Me.cboSen1
.Cells(lRow, 13).Value = Now()

'Check for duplicate data and mark current data with True
If (Is_Present(1, "RCZC2SPTPM") Or Is_Present(2, 2013) Or Is_Present(3, 5) Or Is_Present(10, 3) Or Is_Present(11, 1)) Then
.Cells(lRow, 6).Value = "True"
.Cells(lRow, 13).Value = Now()
MsgBox ("Your Model forecast has been added and no duplicate entries were found")
Me.Add1.BackColor = vbWhite
Else
.Cells(lRow, 6).Value = "False"
.Cells(lRow, 13).Value = Now()
MsgBox ("A duplicate entry was found and your model forecast has been now been updated")
Me.Add1.BackColor = vbWhite
End If
End With


Please help :-)