ALLOW USER TO OVERWRITE ON A DUPLICATE ROW

[tigerdel]

I have code which checks when an entry is trying to be made and the Number in column A [Quote #] of a Table [QuotationList} is already present
Currently, if this true, it simply exits
What I want to do is to ask the User if they want to overwrite the current row with the new data and if they say Yes then overwrite the row otherwise then exit. but I am struggling
This is my current code:

Sub SaveQuotation()
Dim xRng As Range
Dim xrng2 As Range
Dim strQuote As String
Dim TblRng As Range
Dim ws As Worksheet
Dim tbl As ListObject
Dim MyRange As Range, FindQuote As Range
Dim LastRow As Long
Set ws = ActiveSheet
Worksheets("Quotation List").Activate
'THIS IS THE CELL WITH THE QUOTE # IN
strQuote = Sheets("Quotation").Range("G7")
With ThisWorkbook.Worksheets("Quotation List")
'THIS IS THE COLUMN WHERE THE QUOTE # WILL BE PLACED
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
If LastRow = 4 And .Range("A3") = "" Then LastRow = 3
Set FindQuote = .Range("A3:A" & LastRow).Find(strQuote, , xlValues, xlWhole)
'THIS IS WHAT HAPPENS NOW
If Not FindQuote Is Nothing Then
MsgBox "Quotation Number already exists"
Exit Sub
End If
.Cells(LastRow, .Range("QuotationList[Quote '#]").Column) = Sheets("Quotation").Range("G7")
.Cells(LastRow, .Range("QuotationList[Date]").Column) = Sheets("Quotation").Range("G8")
.Cells(LastRow, .Range("QuotationList[Customer]").Column) = Sheets("Quotation").Range("A3")
.Cells(LastRow, .Range("QuotationList[Total]").Column) = Sheets("Quotation").Range("G21")
Set xRng = .Cells(LastRow, .Range("QuotationList[pdf Copy Location]").Column)
Set xrng2 = .Cells(LastRow, .Range("QuotationList[xlsx Copy Location]").Column)
End With
Worksheets("Quotation").Activate
Call SaveQuotationAsPDF(xRng)
Call CopyWorksheet(xrng2)
End Sub

Any suggestions gratefully received
Thanks for looking

 

[Logit]

.
Untested here although the MsgBox premise is sound :

Sub SaveQuotation()
Dim xRng As Range
Dim xrng2 As Range
Dim strQuote As String
Dim TblRng As Range
Dim ws As Worksheet
Dim tbl As ListObject
Dim MyRange As Range, FindQuote As Range
Dim LastRow As Long

Set ws = ActiveSheet

Worksheets("Quotation List").Activate

'THIS IS THE CELL WITH THE QUOTE # IN
strQuote = Sheets("Quotation").Range("G7")

With ThisWorkbook.Worksheets("Quotation List")
    'THIS IS THE COLUMN WHERE THE QUOTE # WILL BE PLACED
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        If LastRow = 4 And .Range("A3") = "" Then LastRow = 3
        
        Set FindQuote = .Range("A3:A" & LastRow).Find(strQuote, , xlValues, xlWhole)
        
        'THIS IS WHAT HAPPENS NOW
        If Not FindQuote Is Nothing Then
            MsgBox "Quotation Number already exists"
            
                Dim OutPut As Integer
                'Example of vbYesNo
                OutPut = MsgBox("Would you like to overwrite the duplicate record with new data ?", vbInformation + vbYesNo, "Overwrite ?")
                If OutPut = 6 Then
                GoTo OvrWrite
                Else
                'Output = 7(No)
                MsgBox "Cancelling overwrite", vbInformation, "Cancel"
                Exit Sub
                End If
OvrWrite:
        
            .Cells(LastRow, .Range("QuotationList[Quote '#]").Column) = Sheets("Quotation").Range("G7")
            .Cells(LastRow, .Range("QuotationList[Date]").Column) = Sheets("Quotation").Range("G8")
            .Cells(LastRow, .Range("QuotationList[Customer]").Column) = Sheets("Quotation").Range("A3")
            .Cells(LastRow, .Range("QuotationList[Total]").Column) = Sheets("Quotation").Range("G21")
            
            Set xRng = .Cells(LastRow, .Range("QuotationList[pdf Copy Location]").Column)
            Set xrng2 = .Cells(LastRow, .Range("QuotationList[xlsx Copy Location]").Column)
        End If
End With

Worksheets("Quotation").Activate
End Sub

 

[tigerdel]

Logit you are a life saver
This works perfectly
Thank you so much

 

[tigerdel]

Ah well nearly, If the Quotation does not exist, it still triggers your code and if I say No it doesn't save
Also, it doesn't overwrite the previous entry, it adds a new row

Any ideas

 

[tigerdel]

OK, I have managed to get it to write to the table if it is a new entry by changing your code to:

Sub SaveQuotation()
Dim xRng As Range
Dim xrng2 As Range
Dim strQuote As String
Dim TblRng As Range
Dim ws As Worksheet
Dim tbl As ListObject
Dim MyRange As Range, FindQuote As Range
Dim LastRow As Long
Set ws = ActiveSheet
Worksheets("Quotation List").Activate
strQuote = Sheets("Quotation").Range("G7")
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
    If LastRow = 4 And Range("A3") = "" Then LastRow = 3
    Set FindQuote = Range("A3:A" & LastRow).Find(strQuote, , xlValues, xlWhole)
    If Not FindQuote Is Nothing Then
'            MsgBox "Quotation Number already exists"
'            Exit Sub
'    End If
Dim OutPut As Integer
    'Example of vbYesNo
    OutPut = MsgBox("Would you like to overwrite the duplicate record with new data ?", vbInformation + vbYesNo, "Overwrite ?")
    If OutPut = 6 Then
'    GoTo OvrWrite
    Cells(LastRow, Range("QuotationList[Quote '#]").Column) = Sheets("Quotation").Range("G7")
    Cells(LastRow, Range("QuotationList[Date]").Column) = Sheets("Quotation").Range("G8")
    Cells(LastRow, Range("QuotationList[Customer]").Column) = Sheets("Quotation").Range("A3")
    Cells(LastRow, Range("QuotationList[Total]").Column) = Sheets("Quotation").Range("G21")
    Set xRng = Cells(LastRow, Range("QuotationList[pdf Copy Location]").Column)
    Set xrng2 = Cells(LastRow, Range("QuotationList[xlsx Copy Location]").Column)
    Else
    'Output = 7(No)
    MsgBox "Cancelling overwrite", vbInformation, "Cancel"
    Exit Sub
    End If
Worksheets("Quotation").Activate
Call SaveQuotationAsPDF(xRng)
Call CopyWorksheet(xrng2) 'OvrWrite:
Else
    Cells(LastRow, Range("QuotationList[Quote '#]").Column) = Sheets("Quotation").Range("G7")
    Cells(LastRow, Range("QuotationList[Date]").Column) = Sheets("Quotation").Range("G8")
    Cells(LastRow, Range("QuotationList[Customer]").Column) = Sheets("Quotation").Range("A3")
    Cells(LastRow, Range("QuotationList[Total]").Column) = Sheets("Quotation").Range("G21")
    Set xRng = Cells(LastRow, Range("QuotationList[pdf Copy Location]").Column)
    Set xrng2 = Cells(LastRow, Range("QuotationList[xlsx Copy Location]").Column)
Worksheets("Quotation").Activate
Call SaveQuotationAsPDF(xRng)
Call CopyWorksheet(xrng2)
End If
End Sub

Just need to work out how to get it to actually OverWrite the row instead of adding a new one

Hope you have an idea