Solved Update Existing Access Records Based on Cell Values (1 Viewer)

meilkew

New member
Local time
Today, 12:19
Joined
Apr 14, 2020
Messages
27
I have Update sheet, this sheet contains unique ID that matched the access database ID, I'm trying to update the fields using excel values in "Update" sheet.
The ID is in the Column A the rest of the fields are stored from Column B to R. I'm trying to achieve the below, As follows:

1. Update the record(values from Column B to R) if Column A (ID) matched existing Access database ID. Then add text in Column S "Updated"
2. If the Column A (ID) did not found any match in the existing Access database ID, Then add text in Column S "ID NOT FOUND"
3. Loop to next value

So far, I have the below Sub for Update and Function for Existing ID (Import_Update Module), but I'm getting this error.
Capture.JPG


Sub Data Update
Code:
Sub Data_Update_DB()

Dim dbPath As String
Dim lastRow As Long
Dim exportedRowCnt As Long
Dim NotexportedRowCnt As Long
Dim qry As String
Dim ID As String

'add error handling
On Error GoTo exitSub

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

    'Variables for file path
    dbPath = Worksheets("Home").Range("P4").Value '"W:\Edward\_Connection\Database.accdb"  '##> This was wrong before pointing to I3

    If Not FileExists(dbPath) Then
        MsgBox "The Database file doesn't exist! Kindly correct first"
            Exit Sub
    End If

    'find las last row of data
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row

    Dim cnx As ADODB.Connection 'dim the ADO collection class
    Dim rst As ADODB.Recordset 'dim the ADO recordset class

    On Error GoTo errHandler

    'Initialise the collection class variable
    Set cnx = New ADODB.Connection

    'Connection class is equipped with a —method— named Open
     cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
  

    'ADO library is equipped with a class named Recordset
    Set rst = New ADODB.Recordset 'assign memory to the recordset

'##> ID and SQL Query
    
    ID = Range("A" & lastRow).Value
    qry = "SELECT * FROM f_SD WHERE ID = '" & ID & "'"
        
    'ConnectionString Open '—-5 aguments—-
    rst.Open qry, ActiveConnection:=cnx, _
    CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
    Options:=adCmdTable

    'add the values to it

    'Wait Cursor
    Application.Cursor = xlWait

    'Pause Screen Update
    Application.ScreenUpdating = False
    
    '##> Set exportedRowCnt to 0 first
    UpdatedRowCnt = 0
    IDnotFoundRowCnt = 0
        '##> Let's suppose Data is on Column B to R.
        
    If rst.EOF And rst.BOF Then
        'Close the recordet and the connection.
        rst.Close
        cnx.Close
        'clear memory
        Set rst = Nothing
        Set cnx = Nothing
        'Enable the screen.
        Application.ScreenUpdating = True
        'In case of an empty recordset display an error.
        MsgBox "There are no records in the recordset!", vbCritical, "No Records"
    Exit Sub
    
    End If
    
    For nRow = 2 To lastRow
        '##> Check if the Row has already been imported?
        'If it is then continue update records
        If IdExists(cnx, Range("A" & nRow).Value) Then
    
        With rst
        
        For nCol = 1 To 18
            rst.Fields(Cells(1, nCol).Value2) = Cells(nRow, nCol).Value 'Using the Excel Sheet Column Heading
        Next nCol
    
        Range("S" & nRow).Value2 = "Updated"
        UpdatedRowCnt = UpdatedRowCnt + 1
    
     rst.Update
    
     End With
    
        Else
              
            '##>Update the Status on Column S when ID NOT FOUND
            Range("S" & nRow).Value2 = "ID NOT FOUND"
            
            'Increment exportedRowCnt
            IDnotFoundRowCnt = IDnotFoundRowCnt + 1
        End If
    Next nRow

    'close the recordset
    rst.Close

    ' Close the connection
    cnx.Close
    'clear memory
    Set rst = Nothing
    Set cnx = Nothing

    If UpdatedRowCnt > 0 Or IDnotFoundRowCnt > 0 Then
        'communicate with the user
        MsgBox UpdatedRowCnt & " Drawing(s) Updated " & vbCrLf & _
          IDnotFoundRowCnt & " Drawing(s) IDs Not Found"
        
    End If  
    
    'Update the sheet
    Application.ScreenUpdating = True
exitSub:
    'Restore Default Cursor
    Application.Cursor = xlDefault

    'Update the sheet
    Application.ScreenUpdating = True
        Exit Sub

errHandler:
    'clear memory
    Set rst = Nothing
    Set cnx = Nothing
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data_Updated"

    Resume exitSub
End Sub

Function to Check if the ID Exists

Code:
Function IdExists(cnx As ADODB.Connection, sId As String) As Boolean

'Set IdExists as False and change to true if the ID exists already
    IdExists = False

'Change the Error handler now
    Dim rst As ADODB.Recordset 'dim the ADO recordset class
    Dim cmd As ADODB.Command   'dim the ADO command class

    On Error GoTo errHandler

    'Sql For search
    Dim sSql As String
    sSql = "SELECT Count(f_SD.ID) AS IDCnt FROM f_SD WHERE (f_SD.ID='" & sId & "')"

    'Execute command and collect it into a Recordset
    Set cmd = New ADODB.Command
    cmd.ActiveConnection = cnx
    cmd.CommandText = sSql

    'ADO library is equipped with a class named Recordset
    Set rst = cmd.Execute 'New ADODB.Recordset 'assign memory to the recordset

    'Read First RST
    rst.MoveFirst

'If rst returns a value then ID already exists
    If rst.Fields(0) > 0 Then
        IdExists = True
    End If

    'close the recordset
    rst.Close

    'clear memory
    Set rst = Nothing
exitFunction:
        Exit Function

errHandler:
    'clear memory
    Set rst = Nothing
        MsgBox "Error " & Err.Number & " :" & Err.Description
End Function
 

Attachments

  • VBA.zip
    406.1 KB · Views: 19

Ranman256

Registered User.
Local time
Today, 04:19
Joined
Apr 9, 2015
Messages
3,704
Couldn't you just attach (link) the excel sheet as an external table,
Then run an update query?
 

meilkew

New member
Local time
Today, 12:19
Joined
Apr 14, 2020
Messages
27
Couldn't you just attach (link) the excel sheet as an external table,
Then run an update query?

I can't because there are multiple end user of the excel file, I have userform for data entry where user can enter new data/delete data/edit data. the access database is in the shared network, I'm trying to add a command button for bulk import and update instead of using the form for entering the data one by one.
 

CJ_London

Super Moderator
Staff member
Local time
Today, 09:19
Joined
Feb 19, 2013
Messages
12,801
I can't because there are multiple end user of the excel file,
that doesn't make sense to me - I think you need to explain your process more clearly - how does data get in to the excel file? (it sounds like you are using excel as an input form, why not just use Access?) - how does the data get uploaded to access? I presume that is the code you show - but the error message refers to procedure Update_DB, the code you have provided is for a sub called Data_Update_DB.

So which line is causing the error? This one?

ID = Range("A" & lastRow).Value
qry = "SELECT * FROM f_SD WHERE ID = '" & ID & "'"


best guess at the moment is ID's are normally numeric in which case you would not use single quotes.
 

meilkew

New member
Local time
Today, 12:19
Joined
Apr 14, 2020
Messages
27
that doesn't make sense to me - I think you need to explain your process more clearly - how does data get in to the excel file? (it sounds like you are using excel as an input form, why not just use Access?) - how does the data get uploaded to access? I presume that is the code you show - but the error message refers to procedure Update_DB, the code you have provided is for a sub called Data_Update_DB.

So which line is causing the error? This one?

ID = Range("A" & lastRow).Value
qry = "SELECT * FROM f_SD WHERE ID = '" & ID & "'"


best guess at the moment is ID's are normally numeric in which case you would not use single quotes.


I'm not familiar with Access that's first. I use the excel form for data entry that stored data in access database, then pull back the records back to the form list box. So far the user form is working well. However, entering the data one by one takes a lot of time for the end user. I want to optimize it by having option to import and update records in bulk.

Being said, I need two subs (import and update), I managed so far to get to the import (new records), which the user have to locate the import_template (standard template that contains unique ID and information to be exported in access database). The template is basically structured based on the access database fields. To make it more consistent and avoid erroneous entry in the database.

Now, I modified the import sub by adding the query which will look into the existing records for the unique ID, then update all the records available in the Update sheet.

The primary key ID in access is short text that's why I have the single quotes

I think I forgot to change the error handler massage box to match the sub. hehehe

Code:
errHandler:
    'clear memory
    Set rst = Nothing
    Set cnx = Nothing
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Update_DB"


I don't think this is the error because it pull the proper ID, but as soon as I hit F8 it goes to the error handler

ID = Range("A" & lastRow).Value
qry = "SELECT * FROM f_SD WHERE ID = '" & ID & "'"


Capture.JPG

Capture_1.JPG
 
Last edited:

Galaxiom

Super Moderator
Staff member
Local time
Today, 20:19
Joined
Jan 20, 2009
Messages
12,173
I have Update sheet, this sheet contains unique ID that matched the access database ID, I'm trying to update the fields using excel values in "Update" sheet.
The ID is in the Column A the rest of the fields are stored from Column B to R. I'm trying to achieve the below, As follows:

1. Update the record(values from Column B to R) if Column A (ID) matched existing Access database ID. Then add text in Column S "Updated"
2. If the Column A (ID) did not found any match in the existing Access database ID, Then add text in Column S "ID NOT FOUND"
3. Loop to next value

So far, I have the below Sub for Update and Function for Existing ID (Import_Update Module), but I'm getting this error.
View attachment 80932

Sub Data Update
Code:
Sub Data_Update_DB()

Dim dbPath As String
Dim lastRow As Long
Dim exportedRowCnt As Long
Dim NotexportedRowCnt As Long
Dim qry As String
Dim ID As String

'add error handling
On Error GoTo exitSub

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

    'Variables for file path
    dbPath = Worksheets("Home").Range("P4").Value '"W:\Edward\_Connection\Database.accdb"  '##> This was wrong before pointing to I3

    If Not FileExists(dbPath) Then
        MsgBox "The Database file doesn't exist! Kindly correct first"
            Exit Sub
    End If

    'find las last row of data
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row

    Dim cnx As ADODB.Connection 'dim the ADO collection class
    Dim rst As ADODB.Recordset 'dim the ADO recordset class

    On Error GoTo errHandler

    'Initialise the collection class variable
    Set cnx = New ADODB.Connection

    'Connection class is equipped with a —method— named Open
     cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
 

    'ADO library is equipped with a class named Recordset
    Set rst = New ADODB.Recordset 'assign memory to the recordset

'##> ID and SQL Query
   
    ID = Range("A" & lastRow).Value
    qry = "SELECT * FROM f_SD WHERE ID = '" & ID & "'"
       
    'ConnectionString Open '—-5 aguments—-
    rst.Open qry, ActiveConnection:=cnx, _
    CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
    Options:=adCmdTable

    'add the values to it

    'Wait Cursor
    Application.Cursor = xlWait

    'Pause Screen Update
    Application.ScreenUpdating = False
   
    '##> Set exportedRowCnt to 0 first
    UpdatedRowCnt = 0
    IDnotFoundRowCnt = 0
        '##> Let's suppose Data is on Column B to R.
       
    If rst.EOF And rst.BOF Then
        'Close the recordet and the connection.
        rst.Close
        cnx.Close
        'clear memory
        Set rst = Nothing
        Set cnx = Nothing
        'Enable the screen.
        Application.ScreenUpdating = True
        'In case of an empty recordset display an error.
        MsgBox "There are no records in the recordset!", vbCritical, "No Records"
    Exit Sub
   
    End If
   
    For nRow = 2 To lastRow
        '##> Check if the Row has already been imported?
        'If it is then continue update records
        If IdExists(cnx, Range("A" & nRow).Value) Then
   
        With rst
       
        For nCol = 1 To 18
            rst.Fields(Cells(1, nCol).Value2) = Cells(nRow, nCol).Value 'Using the Excel Sheet Column Heading
        Next nCol
   
        Range("S" & nRow).Value2 = "Updated"
        UpdatedRowCnt = UpdatedRowCnt + 1
   
     rst.Update
   
     End With
   
        Else
             
            '##>Update the Status on Column S when ID NOT FOUND
            Range("S" & nRow).Value2 = "ID NOT FOUND"
           
            'Increment exportedRowCnt
            IDnotFoundRowCnt = IDnotFoundRowCnt + 1
        End If
    Next nRow

    'close the recordset
    rst.Close

    ' Close the connection
    cnx.Close
    'clear memory
    Set rst = Nothing
    Set cnx = Nothing

    If UpdatedRowCnt > 0 Or IDnotFoundRowCnt > 0 Then
        'communicate with the user
        MsgBox UpdatedRowCnt & " Drawing(s) Updated " & vbCrLf & _
          IDnotFoundRowCnt & " Drawing(s) IDs Not Found"
       
    End If 
   
    'Update the sheet
    Application.ScreenUpdating = True
exitSub:
    'Restore Default Cursor
    Application.Cursor = xlDefault

    'Update the sheet
    Application.ScreenUpdating = True
        Exit Sub

errHandler:
    'clear memory
    Set rst = Nothing
    Set cnx = Nothing
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data_Updated"

    Resume exitSub
End Sub

Function to Check if the ID Exists

Code:
Function IdExists(cnx As ADODB.Connection, sId As String) As Boolean

'Set IdExists as False and change to true if the ID exists already
    IdExists = False

'Change the Error handler now
    Dim rst As ADODB.Recordset 'dim the ADO recordset class
    Dim cmd As ADODB.Command   'dim the ADO command class

    On Error GoTo errHandler

    'Sql For search
    Dim sSql As String
    sSql = "SELECT Count(f_SD.ID) AS IDCnt FROM f_SD WHERE (f_SD.ID='" & sId & "')"

    'Execute command and collect it into a Recordset
    Set cmd = New ADODB.Command
    cmd.ActiveConnection = cnx
    cmd.CommandText = sSql

    'ADO library is equipped with a class named Recordset
    Set rst = cmd.Execute 'New ADODB.Recordset 'assign memory to the recordset

    'Read First RST
    rst.MoveFirst

'If rst returns a value then ID already exists
    If rst.Fields(0) > 0 Then
        IdExists = True
    End If

    'close the recordset
    rst.Close

    'clear memory
    Set rst = Nothing
exitFunction:
        Exit Function

errHandler:
    'clear memory
    Set rst = Nothing
        MsgBox "Error " & Err.Number & " :" & Err.Description
End Function

You have added so many junk comments to what are straightforward procedures that the actual code is hard to see.
Do you really need to comment a Msgbox with "communicate with the user"?
Or explain what Dim means?
Or explain that the ADO library is equipped with a Recordset class?

There is no need to make a Boolean variable or return value False as they are instantiated as False anyway.
 

CJ_London

Super Moderator
Staff member
Local time
Today, 09:19
Joined
Feb 19, 2013
Messages
12,801
You are not passing a table, but a query so your parameter

Options:=adCmdTable

should be

Options:=adCmdText
 

moke123

AWF VIP
Local time
Today, 04:19
Joined
Jan 11, 2013
Messages
2,219
you have numerous errors in your code which would have been caught had you declared option explicit.
 

meilkew

New member
Local time
Today, 12:19
Joined
Apr 14, 2020
Messages
27
You have added so many junk comments to what are straightforward procedures that the actual code is hard to see.
Do you really need to comment a Msgbox with "communicate with the user"?
Or explain what Dim means?
Or explain that the ADO library is equipped with a Recordset class?

There is no need to make a Boolean variable or return value False as they are instantiated as False anyway.

Sorry @CJ_London I'm not a programmer, I want to remember what are those code of lines are for.
 

meilkew

New member
Local time
Today, 12:19
Joined
Apr 14, 2020
Messages
27
Hi @CJ_London ,

this code is not looping to the entire row but only to the last row.

Code:
ID = Range("A" & lastRow).Value
    qry = "SELECT * FROM f_SD WHERE ID = '" & ID & "'"
 

CJ_London

Super Moderator
Staff member
Local time
Today, 09:19
Joined
Feb 19, 2013
Messages
12,801
that is what the code says

Range("A" & lastRow)
 

CJ_London

Super Moderator
Staff member
Local time
Today, 09:19
Joined
Feb 19, 2013
Messages
12,801
it's on the last row - so there won't be a next ID. Clarify exactly what you are trying to do as it is not at all clear what the objective is. All I can say is using excel as a means of inputting data to a database is fraught with potential problems.

My guess is you have got the code from somewhere and are trying to adapt it - suggest you need to understand what it is actually doing before making changes so you can determine where and what that change needs to be.

So step through the code - on each line, see what it is doing and whether that matches up with what you want it to do
 

meilkew

New member
Local time
Today, 12:19
Joined
Apr 14, 2020
Messages
27
it's on the last row - so there won't be a next ID. Clarify exactly what you are trying to do as it is not at all clear what the objective is. All I can say is using excel as a means of inputting data to a database is fraught with potential problems.

My guess is you have got the code from somewhere and are trying to adapt it - suggest you need to understand what it is actually doing before making changes so you can determine where and what that change needs to be.

So step through the code - on each line, see what it is doing and whether that matches up with what you want it to do
E1

Yes, this is what I'm trying to do now, going through line by line of the code. Yes you are correct I'm trying to adapt it to suits my needs. Maybe the code sequence is not correct. I just modify the Export Sub, which is working fine and doing exactly what is supposed to do. But for the Update Sub I just can't put all the pieces in order, but I think I have everything though.

Export Sub () Photo
Capture.JPG


Update Sub () Photo - It says 3 drawings (updated) but only update the last row value in access database
Capture_1.JPG


UserForm Listbox after getting the data in access database
Capture_2.JPG


I know, I'm almost in the finish line, just need to put in order the bunch of codes I have and if I can make a loop to read to the next ID and update the record based on matched primary key ID. I just can't figure out how to do it. I think I need to eat as I have been doing this for almost 8hrs now. bwhahahaha. But I rather do 20hrs fixing this program to run properly than expend hours on typing or pasting it again after receiving the excel files from our subcontractor.
 
Last edited:

CJ_London

Super Moderator
Staff member
Local time
Today, 09:19
Joined
Feb 19, 2013
Messages
12,801
all I can say is your loop needs to start at the first row then move to the next - which you seem to be doing in your idexists sub

write out what you want to do then code it e.g.

Rich (BB code):
start on first row

    check if id exists

        if exists

           do one thing

        else

           do something else

   move to next row and repeat
 

moke123

AWF VIP
Local time
Today, 04:19
Joined
Jan 11, 2013
Messages
2,219
you have numerous errors in your code which would have been caught had you declared option explicit.
Hi @moke123, hehehe.. I wish you could help me out cleanup the mess. hehehe

Well, Put Option Explicit in the declarations section of all the code modules. It will catch all your spelling errors and undeclared variables.
 

Users who are viewing this thread

Top Bottom