Updating a Access table with Data from an Excel spreadsheet using VBA

Been tasked with changing some code to do a new task but unsure how to go about it as I'm pretty new to VBA.

I have an access table called Stock , with columns PartNo, Remark, ProdDesc, Price, cusDesc.

I have a excel spreadsheet with the same columns that have selected items from the Access table which have had their prices updated.

Below is code that I am trying to adapt to allow me to import updated items new prices to the table while keeping the other items intact. Currently this code overwrites the current data in the table with the data in the excel spreadsheet.

Appreciate the help.

Private Sub Command0_Click()
Dim xlApp As Object 
Dim txt As String

Const clmNoPartNo As Integer = 1
Const clmNoRemark As Integer = 2
Const clmNoProdDesc As Integer = 3
Const clmNoPrice As Integer = 4
Const clmNoCusDesc As Integer = 5

Dim myRow As Long
Dim rs As Recordset
Dim filename As String
Dim sql As String

On Error GoTo ErrHandler
    CommonDialog1.filename = ""
    CommonDialog1.showOpen
    If Len(CommonDialog1.filename) < 3 Then Exit Sub
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Workbooks.Open filename:=CommonDialog1.filename

    myRow = 0

    Do
       myRow = myRow + 1
    Loop Until (InStr(xlApp.Cells(myRow, 1), "MDDFieldName_Product_ID") > 0) Or (myRow > 20)
    If myRow > 20 Then
        MsgBox "Column titles not found. Please check format of pricelist."
        xlApp.Quit
        Set xlApp = Nothing
        Exit Sub
    Else
        If ((InStr(xlApp.Cells(myRow, 1), "Product_ID") > 0) And (InStr(xlApp.Cells(myRow, 1), "Product_ID") > 0) And (InStr(xlApp.Cells(myRow, 1), "Product_ID") > 0) And (InStr(xlApp.Cells(myRow, 1), "Product_ID") > 0)) Then
            'nothing
        Else
            MsgBox "Column titles not found. Please check format of pricelist."
            xlApp.Quit
            Set xlApp = Nothing
            Exit Sub
        End If
    End If


    '---Find First Part
    Do
       myRow = myRow + 1
    Loop While (Len(xlApp.Cells(myRow, 1)) < 2) Or (myRow > 30)
    If myRow > 30 Then
        MsgBox "No parts found. Please check format of pricelist."
        xlApp.Quit
        Set xlApp = Nothing
        Exit Sub
    End If


    txt = ""
    DoCmd.SetWaings False
    DoCmd.RunSQL "delete from stock"
    DoCmd.SetWaings True
    Set rs = CurrentDb.OpenRecordset("stock")

    Do
        i = myRow
        Form.Caption = "Importing row :" & i
        rs.AddNew

        rs("PartNo") = xlApp.Cells(i, clmNoPartNo)

        rs("Description") = Left(xlApp.Cells(i, clmNoProdDesc), 100)

        If Len(xlApp.Cells(i, clmNoProdDesc)) > 255 Then
            rs("LongDescription") = Left(xlApp.Cells(i, clmNoProdDesc), 255)

        Else
            rs("LongDescription") = xlApp.Cells(i, clmNoProdDesc)
        End If

        rs("Remarks") = Left(xlApp.Cells(i, clmNoRemark), 255)

        rs("UnitPrice") = xlApp.Cells(i, clmNoPrice)

        rs("CustomerDescription") = xlApp.Cells(i, clmNoCusDesc)

        rs.Update
        myRow = myRow + 1

    Loop While Len(xlApp.Cells(myRow, 1)) > 2

    Form.Caption = ""
    rs.Close
    MsgBox ("Done. " & i & " rows processed.")

    xlApp.Quit
    Set xlApp = Nothing
    'substitute short descriptions
    DoCmd.SetWaings False
    sql = "UPDATE stock INNER JOIN [Short Descriptions] " & _
        "ON stock.PartNo = [Short Descriptions].PartNo " & _
        "SET stock.Description = [short descriptions].[description];"
    DoCmd.RunSQL sql
    DoCmd.SetWaings True
Exit Sub

ErrHandler:
 MsgBox ("Import failed on row: " & i)
    Form.Caption = ""
    rs.Close
 xlApp.Quit
 Set xlApp = Nothing
End Sub