willie68
05-22-2009, 06:49 PM
Hi. I need help to figure out how to fix the problem I am having with a userform that I created to enter names and adddress into an Excel worksheet. Part of the proccess involves not allowing a duplicate address to be entered into the worksheet. When I run the code in the Editor the whole process works fine, but when I run a macro in the workbook for the form everything works fine except the process allowing duplicates.... Can anyone tell me how to fix this? See code below:
thanks. Doug
Private Sub cmdAdd_Click()
Dim RowCount As Long
Dim ctl As Control
'Check User Input
If Me.txtDay.Value = "" Then
MsgBox "Please Enter a Day", vbExclamation, "ClientList"
Me.txtDay.SetFocus
Exit Sub
End If
If Me.txtMonth.Value = "" Then
MsgBox "Please Enter a Month", vbExclamation, "ClientList"
Me.txtMonth.SetFocus
Exit Sub
End If
If Me.txtYear.Value = "" Then
MsgBox "Please Enter a Year", vbExclamation, "ClientList"
Me.txtYear.SetFocus
Exit Sub
End If
If Me.txtTitle.Value = "" Then
MsgBox "Please Enter a Title", vbExclamation, "ClientList"
Me.txtTitle.SetFocus
Exit Sub
End If
If Me.txtFirst.Value = "" Then
MsgBox "Please Enter a First Name", vbExclamation, "ClientList"
Me.txtFirst.SetFocus
Exit Sub
End If
If Me.txtLast.Value = "" Then
MsgBox "Please Enter a Last Name", vbExclamation, "ClientList"
Me.txtLast.SetFocus
Exit Sub
End If
If Me.txtAddress.Value = "" Then
MsgBox "Please Enter an Address", vbExclamation, "ClientList"
Me.txtAddress.SetFocus
Exit Sub
End If
If Me.txtCity.Value = "" Then
MsgBox "Please Enter a City", vbExclamation, "ClientList"
Me.txtCity.SetFocus
Exit Sub
End If
If Me.txtState.Value = "" Then
MsgBox "Please Enter a State", vbExclamation, "ClientList"
Me.txtState.SetFocus
Exit Sub
End If
'Check for Duplicates
If Application.CountIf(Range("H1:H500"), txtAddress.Text) > 0 Then
MsgBox ("This address already exists!")
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
Exit Sub
End If
'Write Data to Worksheet
RowCount = Worksheets("ClientList").Range("A1").CurrentRegion.Rows.Count
With Worksheets("ClientList").Range("A1")
.Offset(RowCount, 0).Value = Me.txtDay.Value
.Offset(RowCount, 1).Value = Me.txtMonth.Value
.Offset(RowCount, 2).Value = Me.txtYear.Value
.Offset(RowCount, 3).Value = Me.txtTitle.Value
.Offset(RowCount, 4).Value = Me.txtFirst.Value
.Offset(RowCount, 5).Value = Me.txtMiddle.Value
.Offset(RowCount, 6).Value = Me.txtLast.Value
.Offset(RowCount, 7).Value = Me.txtAddress.Value
.Offset(RowCount, 8).Value = Me.txtCity.Value
.Offset(RowCount, 9).Value = Me.txtState.Value
End With
'Clear Cells
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
thanks. Doug
Private Sub cmdAdd_Click()
Dim RowCount As Long
Dim ctl As Control
'Check User Input
If Me.txtDay.Value = "" Then
MsgBox "Please Enter a Day", vbExclamation, "ClientList"
Me.txtDay.SetFocus
Exit Sub
End If
If Me.txtMonth.Value = "" Then
MsgBox "Please Enter a Month", vbExclamation, "ClientList"
Me.txtMonth.SetFocus
Exit Sub
End If
If Me.txtYear.Value = "" Then
MsgBox "Please Enter a Year", vbExclamation, "ClientList"
Me.txtYear.SetFocus
Exit Sub
End If
If Me.txtTitle.Value = "" Then
MsgBox "Please Enter a Title", vbExclamation, "ClientList"
Me.txtTitle.SetFocus
Exit Sub
End If
If Me.txtFirst.Value = "" Then
MsgBox "Please Enter a First Name", vbExclamation, "ClientList"
Me.txtFirst.SetFocus
Exit Sub
End If
If Me.txtLast.Value = "" Then
MsgBox "Please Enter a Last Name", vbExclamation, "ClientList"
Me.txtLast.SetFocus
Exit Sub
End If
If Me.txtAddress.Value = "" Then
MsgBox "Please Enter an Address", vbExclamation, "ClientList"
Me.txtAddress.SetFocus
Exit Sub
End If
If Me.txtCity.Value = "" Then
MsgBox "Please Enter a City", vbExclamation, "ClientList"
Me.txtCity.SetFocus
Exit Sub
End If
If Me.txtState.Value = "" Then
MsgBox "Please Enter a State", vbExclamation, "ClientList"
Me.txtState.SetFocus
Exit Sub
End If
'Check for Duplicates
If Application.CountIf(Range("H1:H500"), txtAddress.Text) > 0 Then
MsgBox ("This address already exists!")
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
Exit Sub
End If
'Write Data to Worksheet
RowCount = Worksheets("ClientList").Range("A1").CurrentRegion.Rows.Count
With Worksheets("ClientList").Range("A1")
.Offset(RowCount, 0).Value = Me.txtDay.Value
.Offset(RowCount, 1).Value = Me.txtMonth.Value
.Offset(RowCount, 2).Value = Me.txtYear.Value
.Offset(RowCount, 3).Value = Me.txtTitle.Value
.Offset(RowCount, 4).Value = Me.txtFirst.Value
.Offset(RowCount, 5).Value = Me.txtMiddle.Value
.Offset(RowCount, 6).Value = Me.txtLast.Value
.Offset(RowCount, 7).Value = Me.txtAddress.Value
.Offset(RowCount, 8).Value = Me.txtCity.Value
.Offset(RowCount, 9).Value = Me.txtState.Value
End With
'Clear Cells
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub