Duplicate validation stopping Modify

[Babynod]

Hi All,
on my Login Register my modify was working fine, until i got my duplicate validation working. now when i try to modify (edit) its registering it as a duplicate and it wont allow me to do it.

Username is my unique column which the validation looks at.
e.g employee "marpol" currently has a login with a status of "Enabled" (status is a combobox)
employee no longer needs login so the status needs to be changed to "disabled"

this is my validate code

Function ValidateEntries() As Boolean

ValidateEntries = True

Dim iUsername As Variant

Dim Sh As Worksheet

Set Sh = ThisWorkbook.Sheets("DATABASE")

iUsername = frmFORM.txtUser.Value

With frmFORM

'Default Color

.txtLast.BackColor = vbWhite
.txtFirst.BackColor = vbWhite
.txtUser.BackColor = vbWhite
.cmbStatus.BackColor = vbWhite
.cmbZone.BackColor = vbWhite
.cmbRole.BackColor = vbWhite
.txtPhone.BackColor = vbWhite
.txtPrimaryEmail.BackColor = vbWhite
.txtLocation.BackColor = vbWhite
.cmbRequestedBy.BackColor = vbWhite
'--------------------------------

If Trim(.txtLast.Value) = "" Then

MsgBox "Please enter Last Name.", vbOKOnly + vbInformation, "Last Name"
ValidateEntries = False
.txtLast.BackColor = vbRed
.txtLast.SetFocus
Exit Function

End If

'Validating Duplicate Entries

If Not Sh.Range("D:D").Find(what:=iUsername, lookat:=xlWhole) Is Nothing Then

MsgBox "Duplicate Username found.", vbOKOnly + vbInformation, "Userame"
ValidateEntries = False
.txtUser.BackColor = vbRed
.txtUser.SetFocus
Exit Function

End If

If Trim(.txtFirst.Value) = "" Then

MsgBox "Please enter First Name.", vbOKOnly + vbInformation, "First Name"
ValidateEntries = False
.txtFirst.BackColor = vbRed
.txtFirst.SetFocus
Exit Function

End If

If Trim(.txtUser.Value) = "" Then

MsgBox "Please enter Username.", vbOKOnly + vbInformation, "Username"
ValidateEntries = False
.txtUser.BackColor = vbRed
.txtUser.SetFocus
Exit Function

End If


If Trim(.cmbStatus.Value) = "" Then

MsgBox "Please select Status from drop-down.", vbOKOnly + vbInformation, "Status"
ValidateEntries = False
.cmbStatus.BackColor = vbRed
.cmbStatus.SetFocus
Exit Function

End If

If Trim(.cmbZone.Value) = "" Then

MsgBox "Please select Zone from drop-down.", vbOKOnly + vbInformation, "Zone"
ValidateEntries = False
.cmbZone.BackColor = vbRed
.cmbZone.SetFocus
Exit Function

End If

If Trim(.cmbRole.Value) = "" Then

MsgBox "Please select Role from drop-down.", vbOKOnly + vbInformation, "Role"
ValidateEntries = False
.cmbRole.BackColor = vbRed
.cmbRole.SetFocus
Exit Function

End If


If Trim(.txtPhone.Value) = "" Then

MsgBox "Please enter a Phone Name.", vbOKOnly + vbInformation, "Phone"
ValidateEntries = False
.txtPhone.BackColor = vbRed
.txtPhone.SetFocus
Exit Function

End If

If Trim(.txtPrimaryEmail.Value) = "" Then

MsgBox "Please enter a Primary Email Address.", vbOKOnly + vbInformation, "PrimaryEmail"
ValidateEntries = False
.txtPrimaryEmail.BackColor = vbRed
.txtPrimaryEmail.SetFocus
Exit Function

End If

If Trim(.txtLocation.Value) = "" Then

MsgBox "Please enter a Location.", vbOKOnly + vbInformation, "Location"
ValidateEntries = False
.txtLocation.BackColor = vbRed
.txtLocation.SetFocus
Exit Function

End If

If Trim(.cmbRequestedBy.Value) = "" Then

MsgBox "Please select Requested By from drop-down.", vbOKOnly + vbInformation, "RequestedBy"
ValidateEntries = False
.cmbRequestedBy.BackColor = vbRed
.cmbRequestedBy.SetFocus
Exit Function

End If



End With



End Function

 

[Babynod]

If lngCounter = 2 Then
'Validating Duplicate Entries
If frmFORM.txtrownumber.Value = "" Then
Set rngFound = Sh.Range("D:D").Find(what:=.Value, lookat:=xlWhole, MatchCase:=True)
If Not rngFound Is Nothing Then
Set rngFound = Nothing
MsgBox "Duplicate Username found.", vbOKOnly + vbInformation, "Username"
.BackColor = vbRed
.SetFocus
Exit Function
End If
End If
End If

When i add this in it says "compile error: Next without for" which is strange as where i pasted this code in is between the For and Next.
see my code below theres a FOR at the top and a NEXT at the bottom

With frmFORM
'using a loop to go from the lowest number (arrays haven´t been explicitely dimensioned in the start so it´s 0) to the highest
'(as we started with 0 the highest number is 9 to allow 10 elements)
For lngCounter = LBound(arrCtrlNames) To UBound(arrCtrlNames)
'we refer to Controls here instead of teh "real name" due to looping
With .Controls(arrCtrlNames(lngCounter))
.BackColor = vbWhite
If Trim(.Value) = "" Then
MsgBox arrMsgText(lngCounter), vbOKOnly + vbInformation, arrMsgCaption(lngCounter)
.BackColor = vbRed
.SetFocus
Exit Function
End If
' If lngCounter = 2 Then
' 'Validating Duplicate Entries
' Set rngFound = Sh.Range("D:D").Find(what:=.Value, lookat:=xlWhole, MatchCase:=True)
' If Not rngFound Is Nothing Then
' Set rngFound = Nothing
' MsgBox "Duplicate Username found.", vbOKOnly + vbInformation, "Username"
' .BackColor = vbRed
' .SetFocus
' Exit Function
' End If
' End If
' End With
If lngCounter = 2 Then
'Validating Duplicate Entries
If frmFORM.txtrownumber.Value = "" Then
Set rngFound = Sh.Range("D:D").Find(what:=.Value, lookat:=xlWhole, MatchCase:=True)
If Not rngFound Is Nothing Then
Set rngFound = Nothing
MsgBox "Duplicate Username found.", vbOKOnly + vbInformation, "Username"
.BackColor = vbRed
.SetFocus
Exit Function
End If
End If
End If
Next lngCounter
ValidateEntries = True
End With

 

[Babynod]

sorry just worked out how to correctly comment my code -.-

With frmFORM
  'using a loop to go from the lowest number (arrays haven´t been explicitely dimensioned in the start so it´s 0) to the highest
  '(as we started with 0 the highest number is 9 to allow 10 elements)
  [B][U]For[/U][/B] lngCounter = LBound(arrCtrlNames) To UBound(arrCtrlNames)
    'we refer to Controls here instead of teh "real name" due to looping
    With .Controls(arrCtrlNames(lngCounter))
      .BackColor = vbWhite
      If Trim(.Value) = "" Then
        MsgBox arrMsgText(lngCounter), vbOKOnly + vbInformation, arrMsgCaption(lngCounter)
        .BackColor = vbRed
        .SetFocus
        Exit Function
      End If
'      If lngCounter = 2 Then
'        'Validating Duplicate Entries
'        Set rngFound = Sh.Range("D:D").Find(what:=.Value, lookat:=xlWhole, MatchCase:=True)
'        If Not rngFound Is Nothing Then
'          Set rngFound = Nothing
'          MsgBox "Duplicate Username found.", vbOKOnly + vbInformation, "Username"
'          .BackColor = vbRed
'          .SetFocus
'          Exit Function
'        End If
'      End If
'    End With
    If lngCounter = 2 Then
        'Validating Duplicate Entries
        If frmFORM.txtrownumber.Value = "" Then
          Set rngFound = Sh.Range("D:D").Find(what:=.Value, lookat:=xlWhole, MatchCase:=True)
          If Not rngFound Is Nothing Then
            Set rngFound = Nothing
            MsgBox "Duplicate Username found.", vbOKOnly + vbInformation, "Username"
            .BackColor = vbRed
            .SetFocus
            Exit Function
          End If
        End If
      End If
   [U][B]Next[/B][/U] lngCounter
  ValidateEntries = True
End With

 

[HaHoBe]

Hi Mark,

to my opinion the error description isn´t as good as it would need to be. Problem is not about the For ... Next loop but when commenting code you also did this for the line

'    End With

which leaves the With-clause open. You should need to activate that line.

I have a question of understanding. At present all sheets are open so that any change could be made on sheet Database as well without check. How often will it happen that you change the Username of a person? This depends on the idea how the username is set up - maybe the Last Name and the first charcters of First Name without spaces for 8 characters or a combination of branch (shortened to 2 or 3 characters) added by LastName and First Name.

Do you really need to check the username each time a record is edited or is it the change something that doesn´t happen that often? If this doesn´t happen often I would consider a different approach featuring that the textbox for username is disabled when Edit is pressed. So the check for duplicates may be left out in ValidateEntries. This would mean as well that you would need another button or switch for the change in username (maybe disabling all other controls), depending on whether it´s a button or a switch a a code for checking and putting only the username into the sheet as well as adding a line in procResetControlsUF to enable the textbox for username (or all controls) when run.

And you should have an altered Worksheet_Change spotting Column D and checking for any duplicate. If a duplicate is found you may inform the user that it´s not allowed to double up usernames and use Application.Undo to bring up the original entry.

Ciao,
Holger

 

[Babynod]

Hi HaHoBe

im now getting the below error,

at present all sheets are unlocked for ease of access for me. once its completed and put into production at my company i will lock everything down so they can only access the HOME sheet and the userform.
i then have my ADMIN cmdbutton which unlocks/unhides everything for me to access the database sheet.

im baseing the validation off the username as that is the only unique identifier from our Host system. i cant do first/last names as we have multiple people in the company with the same names. our usernames are based on the first 3 letters of first/lastname or middle/lastname in the case of a double up.

the duplicate only needs to be checked on the initial create, as once created everything BUT the username can be adjusted.

i have also made some changes on my original code now aswell where the submit button does validation (with Edit disabled), when they want to edit they would dbl_click the entry in the listbox which will enable the "edit" button and disable the "submit" button aswell the the username text box, as the "edit" button doesnt have the validate code in it so it will ignore the duplicate code.

 

[HaHoBe]

Hi Mark,

whenever I work on a code in a larger project I prefer to have a backup of how the code looked like before starting on changes (I insert a new module, copy all the code from the original module by using CTRL+A and CTRL+c, insert the code into the nbew module with CTRL+V, comment all the code in the backup and rename the original module adding a date and the new one to the original name). When developing I make use of comments stating when I did the change and why I did so.

Well, the End With is located at the wrong position in the code as the .Value relies on With .Controls(arrCtrlNames(lngCounter)) which ended right before. Please have a look at Post #13 where the original code was shown well as Post #20 for a change of it.

Code looks like this in my version:

'...
With frmFORM
  'using a loop to go from the lowest number (arrays haven´t been explicitely dimensioned in the start so it´s 0) to the highest
  '(as we started with 0 the highest number is 9 to allow 10 elements)
  For lngCounter = LBound(arrCtrlNames) To UBound(arrCtrlNames)
    'we refer to Controls here instead of the "real name" due to looping
    With .Controls(arrCtrlNames(lngCounter))
      .BackColor = vbWhite
      If Trim(.Value) = "" Then
        MsgBox arrMsgText(lngCounter), vbOKOnly + vbInformation, arrMsgCaption(lngCounter)
        .BackColor = vbRed
        .SetFocus
        Exit Function
      End If
      If lngCounter = 2 Then
        'Validating Duplicate Entries
        If frmFORM.txtrownumber.Value = "" Then
          Set rngFound = Sh.Range("D:D").Find(what:=.Value, lookat:=xlWhole, MatchCase:=True)
          If Not rngFound Is Nothing Then
            Set rngFound = Nothing
            MsgBox "Duplicate Username found.", vbOKOnly + vbInformation, "Username"
            .BackColor = vbRed
            .SetFocus
            Exit Function
          End If
        End If
      End If
    End With
  Next lngCounter
  ValidateEntries = True
End With
'...

Maybe you could avoid all the arrays in the code to fill the comboboxes by adding another sheet, give the items named ranges and work on these ranges instead of using the arrays. It would make changes easier i believe.

HTH,
Holger