Avoid duplicate entry

[DharmeshKP]

I have userform for patient data entry. I wants to avoid duplicate entry with a condition that it should not be duplicate on current date. Patient may come after few days and needs to be reentered but it should not happen on same day means on curren date. I tried following code but it shows error. Please help me to debug it.

Private Sub CommandButton2_Click()
Dim x As Long
Dim y As Worksheet
Dim c As Range
Set y = Sheets("Daily")
x = y.Range("A" & Rows.Count).End(xlUp).Row
lrow = y.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
FindDate = Format(Date, "dd/mm/yyyy")
' find first row containing current date
[B]frow = y.Cells.Find(What:=FindDate, SearchDirection:=xlNext, SearchOrder:=xlByRows).Row
'error line in above[/B]

With y.Range(y.Cells(frow, 1), y.Cells(lrow, 1))
Set c = .Find(Me.TextBox1.Value, LookIn:=xlValues, LookAt:=xlWhole)
End With

If c Is Nothing Then
With y
.Cells(x + 1, "A").Value = TextBox1.Text
.Cells(x + 1, "B").Value = TextBox2.Text
.Cells(x + 1, "C").Value = TextBox3.Text
.Cells(x + 1, "D").Value = TextBox4.Text
.Cells(x + 1, "E").Value = TextBox5.Text
.Cells(x + 1, "F").Value = TextBox6.Text
.Cells(x + 1, "G").Value = TextBox7.Text
.Cells(x + 1, "H").Value = TextBox8.Text
.Cells(x + 1, "I").Value = [now()]
.Cells(x + 1, "J").Value = Application.UserName
End With
'clear the data
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
ActiveWorkbook.Save
Else: MsgBox TextBox1.Value & " is already registered "
Exit Sub
End If
End Sub

 

[yinkajewole]

what column has the dates?

 

[yinkajewole]

if your dates are located Column "I" and names are in Column "A" then this should work

Private Sub CommandButton1_Click()
Dim x As Long
Dim y As Worksheet
Dim c As Range
Dim TDate As Long

Set y = Sheets("Daily")
x = y.Range("A" & Rows.Count).End(xlUp).Row
lrow = y.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
For i = 1 To lrow
'search for today's date
If InStr(Format(y.Cells(i, "I"), "dd/mm/yyyy"), Format(Date, "dd/mm/yyyy")) > 0 Then TDate = i: Exit For
Next i
For j = TDate To lrow
'search name starting from today's date row
If Me.TextBox1.Value = y.Cells(j, 1) Then MsgBox TextBox1.Value & " is already registered ": Exit Sub
Next j

With y
.Cells(x + 1, "A").Value = TextBox1.Text
.Cells(x + 1, "B").Value = TextBox2.Text
.Cells(x + 1, "C").Value = TextBox3.Text
.Cells(x + 1, "D").Value = TextBox4.Text
.Cells(x + 1, "E").Value = TextBox5.Text
.Cells(x + 1, "F").Value = TextBox6.Text
.Cells(x + 1, "G").Value = TextBox7.Text
.Cells(x + 1, "H").Value = TextBox8.Text
.Cells(x + 1, "I").Value = [now()]
.Cells(x + 1, "J").Value = Application.UserName
End With
'clear the data
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
ActiveWorkbook.Save
End Sub

 

[DharmeshKP]

Thanks for reply
I tried above code.
It repeatedlly showing error
sometine "next without for"
if I remove next then "for without for"
and also "with without end with"
I tried repeatedly below is final code
error is "next without for"

Private Sub CommandButton2_Click()
Dim x As Long
Dim y As Worksheet
Dim c As Range
Dim TDate As Long

Set y = Sheets("Daily")
x = y.Range("A" & Rows.Count).End(xlUp).Row
lrow = y.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
For i = 1 To lrow
'search for today's date
If InStr(Format(y.Cells(i, "I"), "dd/mm/yyyy"), Format(Date, "dd/mm/yyyy")) > 0 Then TDate = i:
Exit For
Next i
For j = TDate To lrow
'search name starting from today's date row
If Me.TextBox1.Value = y.Cells(j, 1) Then
MsgBox TextBox1.Value & " is already registered today"
Exit Sub
Next j
End If




With y
.Cells(x + 1, "A").Value = TextBox1.Text
.Cells(x + 1, "B").Value = TextBox2.Text
.Cells(x + 1, "C").Value = TextBox3.Text
.Cells(x + 1, "D").Value = TextBox4.Text
.Cells(x + 1, "E").Value = TextBox5.Text
.Cells(x + 1, "F").Value = TextBox6.Text
.Cells(x + 1, "G").Value = TextBox7.Text
.Cells(x + 1, "H").Value = TextBox8.Text
.Cells(x + 1, "I").Value = [now()]
.Cells(x + 1, "J").Value = Application.UserName
End With
'clear the data
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
ActiveWorkbook.Save

End Sub

 

[DharmeshKP]

selected area at next j
after error message

 

[DharmeshKP]

I placed "next j" before "with y"
now it show compile erroe with yellow line
"If Me.TextBox1.Value = y.Cells(j, 1) Then"
I have got stuck up
Please help me

 

[yinkajewole]

Put 'next j' after 'end if'.
By the way i made a mistake in the sub name, please put it back to commandbutton2

 

[DharmeshKP]

Thanks for reply
I have corrected cmd2
I tried placing next and end if at avrious place and finally got it corrected but then also compile error comes with yellow line at
"If Me.TextBox1.Value = y.Cells(j, 1) Then "
I do not understand where is the mistake

 

[DharmeshKP]

I think there ie error in defining TDate
may be TDate= InStr(Format(y.Cells(i, "I"), "dd/mm/yyyy"), Format(Date, "dd/mm/yyyy"))
Please suggest if I am correct

 

[yinkajewole]

I'm sorry this should work fine.

Private Sub CommandButton2_Click()
Dim x As Long
Dim y As Worksheet
Dim c As Range
Dim TDate As Long

Set y = Sheets("Daily")
x = y.Range("A" & Rows.Count).End(xlUp).Row
lrow = y.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
For i = 1 To lrow
'search for today's date
If InStr(Format(y.Cells(i, "I"), "dd/mm/yyyy"), Format(Date, "dd/mm/yyyy")) Then TDate = i: Exit For
Next i
If TDate <> 0 Then
For j = TDate To lrow
'search name starting from today's date row
If Me.TextBox1.Value = y.Cells(j, 1) Then MsgBox TextBox1.Value & " is already registered ": Exit Sub
Next j
End If

With y
.Cells(x + 1, "A").Value = TextBox1.Text
.Cells(x + 1, "B").Value = TextBox2.Text
.Cells(x + 1, "C").Value = TextBox3.Text
.Cells(x + 1, "D").Value = TextBox4.Text
.Cells(x + 1, "E").Value = TextBox5.Text
.Cells(x + 1, "F").Value = TextBox6.Text
.Cells(x + 1, "G").Value = TextBox7.Text
.Cells(x + 1, "H").Value = TextBox8.Text
.Cells(x + 1, "I").Value = [now()]
.Cells(x + 1, "J").Value = Application.UserName
End With
'clear the data
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
ActiveWorkbook.Save
End Sub