VBA code to update / create new record from Excel to Access

Question

I have been trying to look everywhere for an answer, but my low based skills in VBA is really not helping me to figure what I am trying to code.

I have this code so far:

Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=\\GSS_Model_2.4.accdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "Forecast_T", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
For i = 4 To 16
    x = 0
    Do While Len(Range("E" & i).Offset(0, x).Formula) > 0
' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            .Fields("Products") = Range("C" & i).Value
            .Fields("Mapping") = Range("A1").Value
            .Fields("Region") = Range("B2").Value
            .Fields("ARPU") = Range("D" & i).Value
            .Fields("Quarter_F") = Range("E3").Offset(0, x).Value
            .Fields("Year_F") = Range("E2").Offset(0, x).Value
            .Fields("Units_F") = Range("E" & i).Offset(0, x).Value
            .Update
         ' stores the new record
    End With
    x = x + 1
    Loop
Next i
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

This code does exactly what I want thus far. I know want to add a piece that is going to check if the record exist based on 4 rules: Products, Region, Quarter_F and Year_F If it matches these, it should update the other field (Units_F, ARPU). If not, it should run the code properly and create a new record.

Your help will be very much appreciated, I am stucked here and do not see how to get out.

Thank you

Washedup

Answer 1

I have an Excel spreadsheet with the following data starting in cell A1

product  variety  price
bacon    regular  3.79
bacon    premium  4.89
bacon    deluxe   5.99

I have a Table named "PriceList" in my Access database which contains the following data

product  variety  price
-------  -------  -----
bacon    premium  4.99
bacon    regular  3.99

The following Excel VBA will update the existing Access records with the new prices for "regular" and "premium", and add a new row in the table for "deluxe":

Public Sub UpdatePriceList()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim sProduct As String, sVariety As String, cPrice As Variant
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=C:\Users\Gord\Desktop\Database1.accdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "PriceList", cn, adOpenKeyset, adLockOptimistic, adCmdTable

Range("A2").Activate  ' row 1 contains column headings
Do While Not IsEmpty(ActiveCell)
    sProduct = ActiveCell.Value
    sVariety = ActiveCell.Offset(0, 1).Value
    cPrice = ActiveCell.Offset(0, 2).Value

    rs.Filter = "product='" & sProduct & "' AND variety='" & sVariety & "'"
    If rs.EOF Then
        Debug.Print "No existing record - adding new..."
        rs.Filter = ""
        rs.AddNew
        rs("product").Value = sProduct
        rs("variety").Value = sVariety
    Else
        Debug.Print "Existing record found..."
    End If
    rs("price").Value = cPrice
    rs.Update
    Debug.Print "...record update complete."

    ActiveCell.Offset(1, 0).Activate  ' next cell down
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

Requisition

Answer 2

After writing this out I just realized that you are using VBA so my answer won't work. But you should be able to follow what's going on. Here's the idea though. And for VBA collections have a look at this:

VBA Collections

    // First build your list
    Dim myRecords As New Collection

    For i = 4 To 16
    x = 0
    Do While Len(Range("E" & i).Offset(0, x).Formula) > 0

                var list = from t in myRecords
                           where t.Products == Range("C" & i).Value
                           && t.Region == Range("B2").Value
                           && t.Quarter == Range("E3").Offset(0, x).Value
                           && t.Year == Range("E2").Offset(0, x).Value
                           select t;

                var record = list.FirstOrDefault();

                if (record == null)
                {
                    // a record with your key doesnt exist yet.  this is a new record so add a new one to the list
                    record = new CustomObject();
                    record.Products = Range("C" & i).Value;
                    //  etc.  fill in the rest

                    myRecords.Add(record);
                }
                else
                {
                    // we found this record base on your key, so let's update
                    record.Units += Range("E" & i).Offset(0, x).Value;                
                }

    x = x + 1
    Loop
Next i

                // Now loop through your custom object list and insert into database

Brogdon

Thank you for your reply, I understand how you do this but I am really missing the commands that need to be used in order to perform this in VBA... If anyone knows, I will be glad to hear from you too. – Washedup

Last time I checked LINQ was not able to be used in VBA – Rudman

Answer 3

I don't have enough reputation to just comment on one of the above answers. The solution was excellent, but if you have a ton of records in one row to loop over it can be easier to enclose everything into a loop. I also had my data in an Excel Table (but if you just have a non-dynamic range enter that as a range instead).

Set LO = wb.Worksheets("Sheet").ListObjects("YOUR TABLE NAME")
rg = LO.DataBodyRange
'All of the connection stuff from above that is excellent
For x = LBound(rg) To UBound(rg)

'Note that first I needed to find the row in my table containing the record to update
'And that I also got my user to enter all of the record info from a user form
'This will mostly work for you regardless, just get rid of the L/Ubound and search
'Your range for the row you will be working on

    If rg(x,1) = Me.cmbProject.Value Then
        working_row = x
        Exit For
    End If
Next
For i = 2 To 17 ' This would be specific to however long your table is, or another range
'argument would work just as well, I was a bit lazy here
    col_names(i-1) = LO.HeaderRowRange(i) 'Write the headers from table into an array
    Data(i-1) = Me.Controls("Textbox" & i).Value 'Get the data the user entered
Next i
'Filter the Access table to the row you will be entering the data for. I didn't need
'Error checking because users had to select a value from a combobox
rst.Filter = "[Column Name] ='" & "Value to filter on (for me the combobox val)"
For i = 1 To 16 'Again using a len(Data) would work vs. 16 hard code
    rst(col_names(i)).Value = Data(i)
Next i

That's it - then I just closed the database/connections etc. and Gave my user a message saying the data had been written in.

The ONLY thing you really do need to note here is my userform hasn't (yet) incorporated data type checking, but that is my next bit of code. Otherwise you can get exceptions from Access or some really bad looking data when you open it!

Urogenous