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]

Hi,
The code below was taken from another post on this forumsome time ago after looking for a solution..
Ive changed an item or two to suit my form but not sure where i need to insert it & tidy it up etc hence BOLD type
Could you be so kind to advise please.

[B]Private Sub CommandButton2_Click()[/B]'   Add the New Customer Details - Check if duplicate record if so prompt to continue or exit sub
    Dim LastRow As Long
    Dim i As Long
    Dim Answer As Variant
    LastRow = Worksheets("DATABASE").Range("A10000").End(xlUp).Row + 1
    On Error Resume Next
    i = WorksheetFunction.Match([B]TxtSuppName.Text[/B], Worksheets("DATABASE").Range("A1:A" & LastRow), False)
    If Err = 0 Then
        Answer = MsgBox("This Customer already exists, continue Y/N?", vbYesNo, "Duplicate")
        If Answer = vbNo Then Exit Sub
    Else
        Err.Clear
    End If
    On Error GoTo 0
    Worksheets("DATABASE").Range("A" & LastRow).Value = [B]TxtSuppName.Text[/B]
End Sub

 

[ipbr21054]

Anyone please assist when you have spare time.

Thanks

 

[dchaney]

See if this will do what you need... It should look at the DATABASE sheet and if the text in the customer box + anything in column A it will Exit the sub

Private Sub UpdateRecord_Click()

    Dim i As Integer
    Dim IsNewCustomer As Boolean
    Dim Msg As String
    
    Set c = Sheets("DATABASE").Range("A:A").Find(txtCustomer.Text, LookIn:=xlValues)
    
    If Not c Is Nothing Then Exit Sub
    
    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]

Not sure if this is working or not.
Ive applied the code advised,first a use a customers name that isnt stored already & the save goes ahead.
I then make another record but this time with a name that is already in the list.
After i click SAVE CUSTOMER TO DATABASE im waiting & waiting,so either its slow or its done its job & found a match so then then save does not happen.
If this is the case can we have a message box to say CUSTOMER EXISTS etc then i know its finished,clicking on the message box to make it go away i would then alter the customers name so this time it does save.

Thanks for the input.

 

[dchaney]

can we have a message box to say CUSTOMER EXISTS etc then i know its finished,clicking on the message box to make it go away i would then alter the customers name so this time it does save.

Try this,

[COLOR=#333333]Private Sub UpdateRecord_Click()
[/COLOR]
    Dim i As Integer
    Dim IsNewCustomer As Boolean
    Dim Msg As String
    
    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"
          End Sub
    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" 

[COLOR=#333333]End Sub[/COLOR]

 

[ipbr21054]

Compile error Block If Without End If

 

[ipbr21054]

This part of the code,

    If Not c Is Nothing Then          MsgBox "Customer already Exists, file did not save"
          End Sub
    End If

If i remove the End Sub then i see the Customer exists message popup.
But when i click on ok i see the save go ahead into the worksheet followed by the message CUSTOMER SAVED OK ETC

 

[dchaney]

Sorry change the END SUB to EXIT SUB

 

[ipbr21054]

I have had to quickly go out.
Tomorrow i will check and reply here.

many thanks for your efforts with this.
Ian