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

 

[dchaney]

Ok, this should fix your issue, sorry I did not go deep enough originally to see the issues.

Add this to the top of your Private Sub UpdateRecord_Click() right below the DIM...

    If Me.NewRecord.Caption = "CANCEL" Then    
        Set c = Sheets("DATABASE").Range("A:A").Find(txtCustomer.Text, LookIn:=xlValues)
        
        If Not c Is Nothing Then
              MsgBox "Customer already Exists, file did not update"
              Exit Sub
        End If
    
    End If

 

[ipbr21054]

Sames thing happens

 

[dchaney]

Did you remove the added code from all areas?

The Private Sub NewRecord_Click() should be like this:

Private Sub NewRecord_Click()    
    Dim i As Integer
    Dim IsNewCustomer As Boolean
    
    IsNewCustomer = CBool(Me.NewRecord.Tag)
    
    Navigate Direction:=IIf(IsNewCustomer, xlNone, xlPrevious)

    'if new customer, add Date
    If IsNewCustomer Then
        Me.txtJobDate.Text = Format(Date, "dd/mm/yyyy")
        Me.txtCustomer.SetFocus
    End If
    
    ResetButtons IsNewCustomer

End Sub

Your Private Sub UpdateRecord_Click() should look like this:

Private Sub UpdateRecord_Click()    
    Dim i As Integer
    Dim IsNewCustomer As Boolean
    Dim Msg As String
    
    If Me.NewRecord.Caption = "CANCEL" Then
    
        Set c = Sheets("DATABASE").Range("A:A").Find(txtCustomer.Text, LookIn:=xlValues)
        
        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
    
myerror:
Application.EnableEvents = True
'something went wrong tell user
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

 

[ipbr21054]

Now it works.
I copied the code above and its ok,must have the something behind etc.
I will now have a play with it and see what happens.

Many thanks for your time & effort with this.

 

[ipbr21054]

Im happy that it does what i require,thanks for that.
In addition ive added a button on the user form,see empty below code.

Private Sub DeleteRecord_Click()

End Sub

When a customer is shown with there details on the completed user form by clicking this button would remove them from the worksheet DATABASE.

If for example John Smith is shown on the user form which is open,and in my worksheet i have John Smith & John Smith (2) & John Smith (3) it would only need to remove the customer John Smith NOT (2) or (3) etc.

Basically what is currently shown on the user form by clicking this delete record button they will be removed from the worksheet.

Have a nice day.

 

[dchaney]

Im happy that it does what i require,thanks for that.
In addition ive added a button on the user form,see empty below code.

Private Sub DeleteRecord_Click()

End Sub

When a customer is shown with there details on the completed user form by clicking this button would remove them from the worksheet DATABASE.

If for example John Smith is shown on the user form which is open,and in my worksheet i have John Smith & John Smith (2) & John Smith (3) it would only need to remove the customer John Smith NOT (2) or (3) etc.

Basically what is currently shown on the user form by clicking this delete record button they will be removed from the worksheet.

Have a nice day.

Here you go, try this:

Private Sub DeleteRecord_Click()

Set c = Sheets("DATABASE").Range("A:A").Find(txtCustomer.Text, LookIn:=xlValues)


If Not c Is Nothing Then
    Rows(c.Row).EntireRow.Delete
    MsgBox "The record for " & txtCustomer.Text & " has been deleted!"
Else
    MsgBox "There were no records containing customer " & txtCustomer.Text & " to be deleted"
End If


End Sub

 

[ipbr21054]

Thanks.
Ive done that and works as expected so great.
Do you think its a bit brute force ?
In that i mean once the Delete button is pressed the record is gone,do you think we should have a yes no box,yes would continue & delete the record followed by the delete message and no would show a message advising no record was deleted this time.

What do you think on this,you input on this would be great.

 

[dchaney]

Yes, I think that would be a good idea. Either that or save the record to a new sheet that is hidden, for historical reference. Let me know which you would prefer. I am not sure what the data is for, so not sure if historical data is required or not...

 

[dchaney]

If you do want to delete the entire record as there is no need for historical containment then here you are, this will ask first and popup messages depending on a yes or no answer (Yes = deleted, No = not deleted)

Private Sub DeleteRecord_Click()

Set c = Sheets("DATABASE").Range("A:A").Find(txtCustomer.Text, LookIn:=xlValues)

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

End Sub

 

[ipbr21054]

Ok,
Code deleted & replaced with the code shown above.
Are you sure you want to delete etc etc i selected NO and message not deleted was shown,this was fine.

I selected yes but first time i got run time erro 1004 row c etc does not exist ?
I then saved the sheet then opened it again,now i dont get this 1004 error but i do get customer already exists,file did not update after i add a new fresh customer.

I tried to just delete an existing customer by selecting yes and it deleted fine.