Additional code require for currently working code

[ipbr21054]

Morning all,

The supplied code below i believe is what you require & is currently in use BUT i would like an extra piece of code added to it if i may ask please.
This is how it currently works,
I select ADD NEW CUSTOMER TO DATABASE & complete all fields.
I then select SAVE NEW CUSTOMER TO DATABASE,this then saves the data into my worksheet.
This currently works fine.

The extra piece of code i require is as follows,
Once all the fields are completed & SAVE NEW CUSTOMER TO DATABASE is selected BEFORE it is saved to the worksheet check column A to see if there is a match.
The two items that need to be checked would be Customers name on user form & Customers name which is in Column A on my worksheet.
It would work something like this,
If no match is found then allow the save to go ahead,which is what currently happens.
If there is a match then maybe have message box appear saying customer exists etc.
Allow me to then edit that customers name on the user form etc and then be able to select SAVE NEW CUSTOMER TO DATABASE for the save to go ahead.
This will then allow me NOT to have duplicated customers names in my worksheet.
Check should allow upper case / lower case check and not be 100% specific match etc, Dave Tomms / DAVE TOMMS etc etc

Many thanks & hope i have not over explained it ?

Private Sub UpdateRecord_Click()    Dim i As Integer
    Dim IsNewCustomer As Boolean
    Dim Msg As String
    
    
    IsNewCustomer = CBool(Me.UpdateRecord.Tag)
    
    Msg = "CHANGES SAVED SUCCESSFULLY"
    
    If IsNewCustomer Then
    'New record - check all fields entered
    If Not IsComplete(Form:=Me) Then Exit Sub
        r = StartRow
        Msg = "NEW CUSTOMER SAVED TO DATABASE"
        ws.Range("A6").EntireRow.Insert
        ResetButtons Not IsNewCustomer
        Me.NextRecord.Enabled = True
    End If
    
    On Error GoTo myerror
    Application.EnableEvents = False
    'Add / Update Record
    For i = 1 To UBound(ControlNames)
        With Me.Controls(ControlNames(i))
            'check if date value
            If IsDate(.Text) Then
                ws.Cells(r, i).Value = DateValue(.Text)
            ElseIf i = 15 Then
                ws.Cells(r, i).Value = CDbl(.Text)
            Else
                ws.Cells(r, i).Value = UCase(.Text)
            End If
                ws.Cells(r, i).Font.Size = 11
        End With
    Next i
    
    If IsNewCustomer Then Call ComboBoxCustomersNames_Update
        
    ThisWorkbook.Save
    
    'tell user what happened
    MsgBox Msg, 48, Msg
    
myerror:
Application.EnableEvents = True
'something went wrong tell user
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub


Sub ResetButtons(ByVal Status As Boolean)
    
    With Me.NewRecord
        .Caption = IIf(Status, "CANCEL", "ADD NEW CUSTOMER TO DATABASE")
        .BackColor = IIf(Status, &HFF&, &H8000000F)
        .ForeColor = IIf(Status, &HFFFFFF, &H0&)
        .Tag = Not Status
    Me.ComboBoxCustomersNames.Enabled = CBool(.Tag)
    End With
    
    With Me.UpdateRecord
        .Caption = IIf(Status, "SAVE NEW CUSTOMER TO DATABASE", "SAVE CHANGES FOR THIS CUSTOMER")
        .Tag = Status
    End With
End Sub

 

[ipbr21054]

Please wait a moment

 

[ipbr21054]

What i am doing on the user form is for quickness typing A for the customers name then all the others text box 1 1 1 etc etc
Now some save fine but some say customer already exists.

Strange.
I though it was looking for say C of the first name as opposed a 100% match like Chris so i used letters that no names are they like Q etc,but yet again some saved but some said already exists ?
I even deleted the delete button just to see if it had any bearing for some odd reason but no.

 

[dchaney]

The code is looking for a 100% match from what you type in the top middle box (Customer Name) and what is in Column A. So if Q is a name in column A and you type Q it will see it as a duplicate.

 

[ipbr21054]

You have it the wrong way around.

I type A but i am told customer exists,i then try b,c,d and stil customer exists.

Q was saved fine with no customer exists message

Look in column A there is no b c d etc etc is there so why customer exists message

 

[ipbr21054]

Morning.
I have been using this form last night and have noticed the same error.
On the user form by just typing the letter A into the customers name text box then filling in all the other text boxes when i click save i am told that this customer already exists.
This is incorrect as no customer in my worksheet is shown/called as A
If i type B in the user form customers name i am also told the same message.

If no customer called A on my worksheet then why when i go to save the user form receive a message that customer A already exists ?

I am really happy with this so far & if i cant add data into the user form because of this save error then i will only enter data into the worksheet,no big deal just nice to be able to do it both ways but the incorrect save message is stopping me.

 

[dchaney]

Had to adjust the find, try these

Private Sub DeleteRecord_Click()

Dim c As Range

With Sheets("DATABASE")
    Set c = .Range("A:A").Find(What:=txtCustomer.Value, _
                        After:=.Range("A5"), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
End With

If Not c Is Nothing Then
    If MsgBox("Are you sure you want to delete the record for " & txtCustomer.Text & "?", vbYesNo + vbCritical) = vbYes Then
        Rows(c.Row).EntireRow.Delete
        MsgBox "The record for " & txtCustomer.Text & " has been deleted!"
    Else
        MsgBox "The record containing customer " & txtCustomer.Text & " was not deleted!"
    End If
Else
    MsgBox "There were no records containing customer " & txtCustomer.Text & " to be deleted"
End If

Set c = Nothing

End Sub

Private Sub UpdateRecord_Click()

Dim c As Range
Dim i As Integer
Dim Msg As String
Dim IsNewCustomer As Boolean

    If Me.NewRecord.Caption = "CANCEL" Then
        With Sheets("DATABASE")
            Set c = .Range("A:A").Find(What:=txtCustomer.Value, _
                                After:=.Range("A5"), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
        End With
        If Not c Is Nothing Then
              MsgBox "Customer already Exists, file did not update"
              Exit Sub
        End If
    End If
    
    IsNewCustomer = CBool(Me.UpdateRecord.Tag)
       
    Msg = "CHANGES SAVED SUCCESSFULLY"
    
    If IsNewCustomer Then
    'New record - check all fields entered
    If Not IsComplete(Form:=Me) Then Exit Sub
        r = StartRow
        Msg = "NEW CUSTOMER SAVED TO DATABASE"
        ws.Range("A6").EntireRow.Insert
        ResetButtons Not IsNewCustomer
        Me.NextRecord.Enabled = True
    End If
    
    On Error GoTo myerror
    Application.EnableEvents = False
    'Add / Update Record
    For i = 1 To UBound(ControlNames)
        With Me.Controls(ControlNames(i))
            'check if date value
            If IsDate(.Text) Then
                ws.Cells(r, i).Value = DateValue(.Text)
            ElseIf i = 15 Then
                ws.Cells(r, i).Value = CDbl(.Text)
            Else
                ws.Cells(r, i).Value = UCase(.Text)
            End If
                ws.Cells(r, i).Font.Size = 11
        End With
    Next i
    
    If IsNewCustomer Then Call ComboBoxCustomersNames_Update
        
    ThisWorkbook.Save
    
    'tell user what happened
    MsgBox Msg, 48, Msg
    
    Set c = Nothing

myerror:
Application.EnableEvents = True
'something went wrong tell user
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

 

[ipbr21054]

Evening,
That is now working well and no errors at all.

A question for you if i may.
You will see on the user form there is a drop down box which has all the customers names which match the names on the worksheet in column A
Lets say that there is a customer in the drop down list called Tom Brown.
I select his name Tom Brown from the drop down list & he is now on the user form with all the text boxes complete.
I wish to now delete this customer.
I select delete this customers record,i see the message asking me if i am sure i wish to delete him of which i select yes.
I am then told record for Tom Brown was deleted.
If i keep the user form open and browse / select through the other customers, Tom Brown is still shown in the drop down list but i can see he has been delete from the worksheet.
Even if i select his name i can still bring him up.

When i say yes to the message, are you sure you want to delete this record etc i see straight away the customer is deleted in the worksheet,can we then after that process refresh the drop down list so Tom Brown is not there ?
So far only way to not see him after the delete is to close the user form & the open it again.

 

[dchaney]

Here you are, change your delete macro to the following

Private Sub DeleteRecord_Click()

Dim c As Range

With Sheets("DATABASE")
    Set c = .Range("A:A").Find(What:=txtCustomer.Value, _
                        After:=.Range("A5"), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
End With

If Not c Is Nothing Then
    If MsgBox("Are you sure you want to delete the record for " & txtCustomer.Text & "?", vbYesNo + vbCritical) = vbYes Then
        Rows(c.Row).EntireRow.Delete
        MsgBox "The record for " & txtCustomer.Text & " has been deleted!"
    Else
        MsgBox "The record containing customer " & txtCustomer.Text & " was not deleted!"
    End If
Else
    MsgBox "There were no records containing customer " & txtCustomer.Text & " to be deleted"
End If

Set c = Nothing

Unload Me
Database.Show

End Sub

 

[ipbr21054]

Working well i must say,thanks.

On my worksheet i have a button where once pressed it sorts the customers records A-Z
Here it is below

Private Sub Imagesort_Click()    Dim x As Long
        Application.ScreenUpdating = False
        With Sheets("DATABASE")
        If .AutoFilterMode Then .AutoFilterMode = False
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
                .Range("A5:O" & x).Sort key1:=Range("A6"), order1:=xlAscending, Header:=xlGuess
    End With
    ActiveWorkbook.Save
       Application.ScreenUpdating = True
    Sheets("DATABASE").Range("A6").Select
   End Sub

Now on the user form after i add a fresh customer,which is entered into Row 6 i would like it to then sort them A-Z then followed by the NEW CUSTOMER SAVED TO DATABASE message.
Or if possible and better still i think "what do you think" as opposed to putting into Row 6 then sort A-Z forget the Row 6 & just have the new customer put into the correct position within the A-Z range etc.

Thanks once again.

 

[dchaney]

The easiest thing to do would be the following:

Private Sub UpdateRecord_Click()

Dim c As Range
Dim i As Integer
Dim Msg As String
Dim IsNewCustomer As Boolean


    If Me.NewRecord.Caption = "CANCEL" Then
        With Sheets("DATABASE")
            Set c = .Range("A:A").Find(What:=txtCustomer.Value, _
                                After:=.Range("A5"), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
        End With
        If Not c Is Nothing Then
              MsgBox "Customer already Exists, file did not update"
              Exit Sub
        End If
    End If
    
    IsNewCustomer = CBool(Me.UpdateRecord.Tag)
       
    Msg = "CHANGES SAVED SUCCESSFULLY"
    
    If IsNewCustomer Then
    'New record - check all fields entered
    If Not IsComplete(Form:=Me) Then Exit Sub
        r = StartRow
        Msg = "NEW CUSTOMER SAVED TO DATABASE"
        ws.Range("A6").EntireRow.Insert
        ResetButtons Not IsNewCustomer
        Me.NextRecord.Enabled = True
    End If
    
    On Error GoTo myerror
    Application.EnableEvents = False
    'Add / Update Record
    For i = 1 To UBound(ControlNames)
        With Me.Controls(ControlNames(i))
            'check if date value
            If IsDate(.Text) Then
                ws.Cells(r, i).Value = DateValue(.Text)
            ElseIf i = 15 Then
                ws.Cells(r, i).Value = CDbl(.Text)
            Else
                ws.Cells(r, i).Value = UCase(.Text)
            End If
                ws.Cells(r, i).Font.Size = 11
        End With
    Next i
    
    If IsNewCustomer Then
        Call ComboBoxCustomersNames_Update
        
        With Sheets("DATABASE")
            If .AutoFilterMode Then .AutoFilterMode = False
            x = .Cells(.Rows.Count, 1).End(xlUp).Row
                    .Range("A5:O" & x).Sort key1:=Range("A6"), order1:=xlAscending, Header:=xlGuess
        End With
              
    End If
    
    ThisWorkbook.Save
    
    'tell user what happened
    MsgBox Msg, 48, Msg
    
    Set c = Nothing
    
myerror:
Application.EnableEvents = True
'something went wrong tell user
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"


End Sub