Help with vba, if record exists overwrite ?

[vsantoro]

I have this small excel sheet im using to add projects to a hidden project tab.
right now no matter what i put in it will add no problems.

but what i would like for it to do is.. if the IPS number is found, to overwrite the row, if not found just add it.

can anyone help with this ?

i have attached the xls.

[Leith Ross]

Hello vsantoro,

Here is the amended macro for the "Add" button. This change has been added to the attached workbook.

Private Sub cmdAdd_Click()

  Dim iRow As Long
  Dim Rng As Range
  Dim ws As Worksheet
  
    Set ws = Worksheets("Project_DB")

   'find  first empty row in database
    iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

   'get all the database entires
    Set Rng = ws.Range("A2", ws.Cells(iRow, "A"))

   'check for a part number
    If Trim(Me.txtPart.Value) = "" Then
      Me.txtPart.SetFocus
      MsgBox "Please enter IPS Number"
      Exit Sub
    End If

   'Check if part exits in database
    If Not Rng.Find(txtPart, , xlValues, xlWhole, xlByRows, xlPrevious, False) Is Nothing Then
      MsgBox "Part Number '" & txtPart & "' has already been entered."
      Exit Sub
    End If
   
   'copy the data to the database
    ws.Cells(iRow, 1).Value = Me.txtPart.Value
    ws.Cells(iRow, 2).Value = Me.txtLoc.Value
    ws.Cells(iRow, 3).Value = Me.txtDate.Value

   'clear the data
    Me.txtPart.Value = ""
    Me.txtLoc.Value = ""
    Me.txtDate.Value = ""
    Me.txtPart.SetFocus

End Sub

[vsantoro]

Thank you Leith. I see now when I add a project it says it has already been entered which is great, but is there a way to now overwrite that row in the project_DB tab with the new data ?

[Leith Ross]

Hello vsantoro,

The macro will now ask if you want to overwrite the record. Here is the code. It has been added to the attached workbook also.

Private Sub cmdAdd_Click()

  Dim Answer As Integer
  Dim iRow As Long
  Dim Msg As String
  Dim PartCell As Range
  Dim Rng As Range
  Dim RngEnd As Range
  Dim ws As Worksheet
  
    Set ws = Worksheets("Project_DB")

   'get all the database entires
    Set Rng = ws.Range("A2")
    Set RngEnd = ws.Cells(Rows.Count, "A").End(xlUp)
    Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, ws.Range(Rng, RngEnd))

   'check for a part number
    If Trim(Me.txtPart.Value) = "" Then
      Me.txtPart.SetFocus
      MsgBox "Please enter IPS Number"
      Exit Sub
    End If

   'Check if part exits in database
    Set PartCell = Rng.Find(txtPart, , xlValues, xlWhole, xlByRows, xlPrevious, False)
      If Not PartCell Is Nothing Then
        Msg = "Part Number '" & txtPart & "' has already been entered." & vbCrLf _
            & "Do wish to overwrite this record?"
        Answer = MsgBox(Msg, vbQuestion + vbYesNo)
        If Answer = vbNo Then Exit Sub
        iRow = PartCell.Row
      Else
        iRow = RngEnd.Row + 1
      End If
   
   'copy the data to the database
    ws.Cells(iRow, 1).Value = Me.txtPart.Value
    ws.Cells(iRow, 2).Value = Me.txtLoc.Value
    ws.Cells(iRow, 3).Value = Me.txtDate.Value

   'clear the data
    Me.txtPart.Value = ""
    Me.txtLoc.Value = ""
    Me.txtDate.Value = ""
    Me.txtPart.SetFocus

End Sub

[vsantoro]

Thank you very much for your help.