Solved Update Existing Access Records Based on Cell Values

[meilkew]

Hi @CJ_London , I'm getting nowhere looping the primary key ID? Any advice what I'm missing here?

Option Explicit

Sub Update_DB_1()
 
    Dim cnx As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim qry As String
    Dim id
    Dim sFilePath As String
    Dim lastRow, nRow, nCol, a  As Long
       
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
   
    sFilePath = Worksheets("Home").Range("P4").Value
   
    a = 2
   
    id = VBA.Trim(Sheet4.Cells(a, 1))
   
    cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sFilePath

    qry = "SELECT * FROM f_SD WHERE ID = '" & id & "'"
       
    rst.Open qry, cnx, adOpenKeyset, adLockOptimistic

For a = 2 To lastRow
   
  For nRow = 2 To lastRow
       
        If IdExists(cnx, Range("A" & nRow).Value) Then
                     
              'Update RecordSet
                For nCol = 2 To 9
                    rst.Fields(Cells(1, nCol).Value2) = Cells(nRow, nCol).Value 'Using the Excel Sheet Column Heading
                Next nCol
         
        rst.Update
       
         Else
       
            Range("S" & nRow).Value2 = "ID NOT FOUND"
         
        End If
     
    Next nRow
a = a + 1
Next a

    rst.Close
    cnx.Close
   
    Set rst = Nothing
    Set cnx = Nothing

   MsgBox "Updated Successfully", vbInformation
   
End Sub

 

[meilkew]

Update: Closed, Thanks to all of your help guys. I got someone from other forum, helped me fixed the code. I'm posting it here the finished code. In hope that someone might benefit.

Sub Update_DB()

    Dim cnx As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim qry As String, id As String, sFilePath As String
    Dim lastRow As Long, nRow As Long, nCol As Long, updatedRowCnt  As Long, NoIdRowCnt As Long
    Dim imsg As VbMsgBoxResult

    If Worksheets("Update").Range("A2").Value = "" Then
        MsgBox "Add the data that you want to send to MS Access"
        Exit Sub
    End If

    imsg = MsgBox("Confirm Bulk Update?", vbYesNo + vbQuestion, "Transfer Confirmation")
    If imsg = vbNo Then Exit Sub
    
Application.ScreenUpdating = False
Application.DisplayAlerts = False


    Dim wb As Workbook, ws As Worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Update")

    lastRow = ws.Cells(Rows.count, 1).End(xlUp).Row
    sFilePath = wb.Worksheets("Home").Range("P4").Value

    cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sFilePath

    updatedRowCnt = 0
    NoIdRowCnt = 0
    For nRow = 2 To lastRow

        id = Trim(ws.Cells(nRow, 11))
        qry = "SELECT * FROM f_SD WHERE ID = '" & id & "'"
        Debug.Print qry

        rst.Open qry, cnx, adOpenKeyset, adLockOptimistic
        If rst.RecordCount > 0 Then
            ' Update RecordSet using the Column Heading
            For nCol = 3 To 10
                rst.Fields(Cells(1, nCol).Value2) = Cells(nRow, nCol).Value
            Next nCol
            rst.Update
            updatedRowCnt = updatedRowCnt + 1
            ws.Range("L" & nRow).Value2 = "Updated"
            ws.Range("L" & nRow).Font.Color = vbBlack
        Else
            ws.Range("L" & nRow).Value2 = "ID NOT FOUND"
            ws.Range("L" & nRow).Font.Color = vbRed
            NoIdRowCnt = NoIdRowCnt + 1
        End If

        rst.Close

    Next nRow

    cnx.Close
    Set rst = Nothing
    Set cnx = Nothing

    If updatedRowCnt > 0 Or NoIdRowCnt > 0 Then
        'communicate with the user
        MsgBox updatedRowCnt & " Drawing(s) Updated " & vbCrLf & _
          NoIdRowCnt & " Drawing(s) ID Not Found"
    End If

Application.ScreenUpdating = False
Application.DisplayAlerts = False

End Sub