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

 

[HaHoBe]

Hi,

the extension for any workbook with macros should end up in xlsm (or xlsb), if I try to open the link there is an error stating that the extension (non macro) does not fit the contents (macro). Sorry, neither my desktop nor notebook (Windows10/11) can open a view to the workbook or save it to any folder on my disks.

Ciao,
Holger

 

[Babynod]

Hi,

the extension for any workbook with macros should end up in xlsm (or xlsb), if I try to open the link there is an error stating that the extension (non macro) does not fit the contents (macro). Sorry, neither my desktop nor notebook (Windows10/11) can open a view to the workbook or save it to any folder on my disks.

Ciao,
Holger

Hi,
strange the other one opened differently for you as its saved on my end as an xlsm

ok try this, it says its in ,xlsm, the macro type of save,

WMS Login Register copy.xlsm

Shared with Dropbox

www.dropbox.com

 

[HaHoBe]

Hi there,

okay, I have downloaded a copy of the workbook.

When I first opened the workbook, I had to take care of the columnwidths for the listbox as my system expects a semicolon instaed of a comma. I changed the function you have cited in the opening post to

Function ValidateEntries() As Boolean

'modified 10. Aug. 2022, HaHoBe
'Reason: implementing arrays to make use of a loop and shorten code for checking entries or duplicates

Dim Sh              As Worksheet
Dim rngFound        As Range        'range for duplicate username
Dim arrCtrlNames    As Variant      'Array to hold the names of the controls in the userform
Dim arrMsgText      As Variant      'Array for the body of the MessageBox
Dim arrMsgCaption   As Variant      'Array for the caption of MsgBox
Dim lngCounter      As Long         'used for looping through the array

Set Sh = ThisWorkbook.Sheets("DATABASE")
ValidateEntries = False

'!!!Please keep in mind:
'there is no checking for the number of objects in either of the arrays.
'As I only use one counter the arrays should all have the same number of elements
'to avoid errors - here it´s 10 for all of them
'!!!
arrCtrlNames = Array("txtLast", "txtFirst", "txtUser", "cmbStatus", "cmbZone", "cmbRole", "txtPhone", "txtPrimaryEmail", "txtLocation", "cmbRequestedBy")
arrMsgText = Array("Please enter Last Name.", "Please enter First Name.", "Please enter Username.", "Please select Status from drop-down.", _
                    "Please select Zone from drop-down.", "Please select Role from drop-down.", "Please enter a Phone Name.", _
                    "Please enter a Primary Email Address.", "Please enter a Location.", "Please select Requested By from drop-down.")
arrMsgCaption = Array("Last Name", "First Name", "Username", "Status", "Zone", "Role", "Phone", "PrimaryEmail", "Location", "RequestedBy")

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
  Next lngCounter
  ValidateEntries = True
End With

Set Sh = Nothing

End Function

The information about a duplicate is passed when Username already listed inside the database.

Please check by yourself.

In my version I used a different approach to get the last row (and first free if needed) like

    With ThisWorkbook.Sheets("DATABASE")
      lRow = .Range("A" & .Rows.Count).End(xlUp).Row 'identifying the last row
    End With

And I altered in cmdSubmit_Click

    If ValidateEntries() Then
        Submit
    Else
        Exit Sub ' you´d get a mail on any missing entry or duplicate instead of one when it's successfull
    End If

Maybe I will have time to look at the other code later on.

Ciao,
Holger

 

[Babynod]

Hi HaHoBe

Function ValidateEntries() As Boolean

'modified 10. Aug. 2022, HaHoBe
'Reason: implementing arrays to make use of a loop and shorten code for checking entries or duplicates

Dim Sh As Worksheet
Dim rngFound As Range 'range for duplicate username
Dim arrCtrlNames As Variant 'Array to hold the names of the controls in the userform
Dim arrMsgText As Variant 'Array for the body of the MessageBox
Dim arrMsgCaption As Variant 'Array for the caption of MsgBox
Dim lngCounter As Long 'used for looping through the array

Set Sh = ThisWorkbook.Sheets("DATABASE")
ValidateEntries = False

'!!!Please keep in mind:
'there is no checking for the number of objects in either of the arrays.
'As I only use one counter the arrays should all have the same number of elements
'to avoid errors - here it´s 10 for all of them
'!!!
arrCtrlNames = Array("txtLast", "txtFirst", "txtUser", "cmbStatus", "cmbZone", "cmbRole", "txtPhone", "txtPrimaryEmail", "txtLocation", "cmbRequestedBy")
arrMsgText = Array("Please enter Last Name.", "Please enter First Name.", "Please enter Username.", "Please select Status from drop-down.", _
"Please select Zone from drop-down.", "Please select Role from drop-down.", "Please enter a Phone Name.", _
"Please enter a Primary Email Address.", "Please enter a Location.", "Please select Requested By from drop-down.")
arrMsgCaption = Array("Last Name", "First Name", "Username", "Status", "Zone", "Role", "Phone", "PrimaryEmail", "Location", "RequestedBy")

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
Next lngCounter
ValidateEntries = True
End With

Set Sh = Nothing

End Function
The information about a duplicate is passed when Username already listed inside the database.

Please check by yourself.

ive put this code into mine as a direct replacement for my posted code above but its still saying duplicate username found when i try to edit an entry

In my version I used a different approach to get the last row (and first free if needed) like

With ThisWorkbook.Sheets("DATABASE")
lRow = .Range("A" & .Rows.Count).End(xlUp).Row 'identifying the last row
End With

im not too sure where this one goes.

And I altered in cmdSubmit_Click

If ValidateEntries() Then
Submit
Else
Exit Sub ' you´d get a mail on any missing entry or duplicate instead of one when it's successfull
End If

thats fine i need the notification when someone as successfully updated as i then need to use that information to create/edit/remove the login from our WMS

Maybe I will have time to look at the other code later on.

its much appreciated

 

[HaHoBe]

Hi,

I´ve worked a bit on a copy of the workbook, changed some code and put in some comments and hints that I considered to be helpful but still left some work to do.

WMS Login Register copy _mod220810.xlsm

Microsoft Excel Workbook

1drv.ms

Please have a look at the code. I changed the comboboxes to only allow the values being added (no free ones) and noticed that the module for printing overwrites values that were exported prior. I put some guesses into the comment there too. And I implemented another way for searching by applying the AdvancedFilter (it´s static at the moment but code for execution is included in a module).

Have fun...

HTH,
Holger

 

[HaHoBe]

Hi there,

changing Names and Codenames of Sheets may lead to errors if not noted in time - sorry for that.

In the version I uploaded you may need to change Sheet Home to read

Private Sub Worksheet_Activate()

  tblHome.ScrollArea = "A1:M22"

End Sub

I updated this so maybe the error won´t be thrown in the copy you may download.

What really made me post is that on your form you have a button to bring the contents of the chosen row in the listbox. There is a Click-event for the ListBox which could be ustilized to bring the data up instead of using a button. Maybe an alternative as data would automaticly be changed if another item is selected.

That´s all for today from me.
Holger

 

[Babynod]

Hi,

I´ve worked a bit on a copy of the workbook, changed some code and put in some comments and hints that I considered to be helpful but still left some work to do.

WMS Login Register copy _mod220810.xlsm

Microsoft Excel Workbook

1drv.ms

Please have a look at the code. I changed the comboboxes to only allow the values being added (no free ones) and noticed that the module for printing overwrites values that were exported prior. I put some guesses into the comment there too. And I implemented another way for searching by applying the AdvancedFilter (it´s static at the moment but code for execution is included in a module).

Have fun...

HTH,
Holger

thanks heaps. i did notice alot of commenting with the printing areas of the module, its only in there because the video i followed had it there and i thought it might be affecting my duplicate validation issue. if its not ill most likely just remove those sections of code as i have no need to print this data

 

[Babynod]

Hey HaHoBe

i realy appreciate the effort your putting into this for me,
sorry if im missing something or im not understanding but its still showing the duplicate username when trying to edit using the link you posted above,

in the below snip i selected the first line and clicked edit, then this got the info back into the fields. i then changed the status from "enabled" to "create" and select the requested by box again(as this goes blank when status is changed which is what i want). then i click submit to update the details and it shows the "duplicate username found" error.

 

[Babynod]

i ended up making my edit button a copy of submit but without the validation, edit button is disabled until you double click the entry in the list box to edit which then enables the edit button and disables the submit button. once data is modified and you hit edit, the edit button becomes disabled again and the submit button becomes enabled to start fresh

 

[HaHoBe]

Hi Mark,

the message will be displayed if you choose to edit an existing record from the list. If you try to save the data the check will be made and a duplicate be found. But it could be easily avoided as you may have a look at frmFORM.txtrownumber.Value which will show the number of the row in which an existing record is öcateded.

So inside ValidateEntries in Module1 you should alter the code to read

'...
      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
'...

Having fixed this you would need to add a line in cmdSubmit_Click as I forgot to exit the Sub if no error occurred:

'...
Exit_here:
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
    Exit Sub              'exit without error
Err_here:
    Debug.Print "==Information on error=="
    Debug.Print "Error occurred " & Now & vbCrLf & _
      "Error number: " & Err.Number & vbCrLf & _
      "Error Description: " & Err.Description
    MsgBox "Error description to be found in Immediate Window"
    Resume Exit_here

Same procedure, please change to read

    Dim strBody As String

and later on in the code

    strBody = "Account Updated Requested by " & Trim(ThisWorkbook.Sheets("DATABASE").Cells(lRow, 2).Value)

Ciao,
Holger