PDA

View Full Version : Solved: how to stop duplicat data entry



rrosa1
04-30-2010, 06:12 AM
hi
how can i stop duplicate data entry in column A in user form combo box
my code work in different WB buy not in this one any help is greatly appreciated.
i am missing some thing in the code and after compering the anther code which work in my anther WB i did not find any deference for checking the combo Box duplicate entry if any one can find it will be great help


Option Explicit
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim i As Long
Dim ws1 As Worksheet


'UnProtect the sheet before adding the data
Sheets("Today").Unprotect Password:=""

If Trim(Me.Rmno.Value) = "" Then
Me.Rmno.SetFocus
MsgBox "Please enter the Room No"
Exit Sub
End If




Set ws1 = Worksheets("Today")

For i = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
If Me.Rmno.Value = ws1.Cells(i, 1).Value Then
If MsgBox("Room already Rented. You can not rent again", vbYesNo) = vbNo Then
Exit Sub
Else
Exit For
End If
End If
Next i




Set ws = Worksheets("Today")
'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'check for a Name and Rm number
If Trim(Me.txtfname.Value) = "" Then
MsgBox "Please enter First Name information"
Exit Sub
End If
If Trim(Me.Days.Value) = "" Then
Me.Days.SetFocus
MsgBox "Please enter the Days"
Exit Sub
End If

If Trim(Me.txtlname.Value) = "" Then
Me.txtlname.SetFocus
MsgBox "Please enter the Last Name"
Exit Sub
End If



If Trim(Me.txtopen.Value) = "" Then
Me.txtopen.SetFocus
MsgBox "Please enter the Payment As Cash"
Exit Sub
End If

If Trim(Me.ptype.Value) = "" Then
Me.ptype.SetFocus
MsgBox "Please enter the Payment As Credit Card"
Exit Sub
End If





'copy the data to the database
ws.Cells(iRow, 3).Value = Me.txtfname.Value
ws.Cells(iRow, 2).Value = Me.Days.Value
ws.Cells(iRow, 14).Value = Me.txtlname.Value
ws.Cells(iRow, 6).Value = Me.ptype.Value
ws.Cells(iRow, 1).Value = Me.Rmno.Value
ws.Cells(iRow, 5).Value = Me.txtopen.Value
ws.Cells(iRow, 16).Value = Me.Remark.Value
ws.Cells(iRow, 13).Value = Now

'clear the data

Me.Days.Value = ""
Me.ptype.Value = ""
Me.Rmno.Value = ""
Me.txtopen.Value = ""
Me.txtlname.Value = ""
Me.txtfname.Value = ""
Me.Remark.Value = ""
Me.Rmno.SetFocus
'Protect the sheet after adding the data
Sheets("Today").Protect Password:=""


End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub CommandButton3_Click()
'clear the data
Me.Remark.Value = ""
Me.ptype.Value = ""
Me.Rmno.Value = ""
Me.txtopen.Value = ""
Me.txtlname.Value = ""
Me.txtfname.Value = ""
Me.Days.Value = ""
End Sub
Private Sub UserForm_Initialize()
Me.Rmno.RowSource = "Rms"
Me.ptype.RowSource = "paytype"
End Sub

rrosa1
04-30-2010, 10:13 AM
hi for info
i am narrowing the code which seems not working can some body help.


Set ws1 = Worksheets("Today")

For i = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
If Me.Rmno.Value = ws1.Cells(i, 1).Value Then
If MsgBox("Room already Rented. You can not rent again", vbYesNo) = vbNo Then
Exit Sub
Else
Exit For
End If
End If
Next i

Bob Phillips
04-30-2010, 10:25 AM
Should it be



Set ws1 = Worksheets("Today")

For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
If Me.Rmno.Value = ws1.Cells(i, 1).Value Then
If MsgBox("Room already Rented. You can not rent again", vbYesNo) = vbNo Then
Exit Sub
Else
Exit For
End If
End If
Next i

rrosa1
04-30-2010, 10:48 AM
thanks xld
i change the code but still userform allow the duplicate entry pl look in to the attached WB which have the userForm and also the data sheet where they store the data
thanks for help

Bob Phillips
04-30-2010, 11:48 AM
Set ws1 = Worksheets("Today")

For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row

If Val(Me.Rmno.Value) = ws1.Cells(i, 1).Value Then

If MsgBox("Room already Rented. You can not rent again", vbYesNo) = vbNo Then

Exit Sub
Else

Exit For
End If
End If
Next i

rrosa1
04-30-2010, 12:05 PM
thanks xld
great work now it work finally.
u the man.