copying certain record from excel to access

I have an excel file that has a sheet with a table that gets populated through some macros and then the records that get populated are manually pasted into access then. The table in excel is always 17 rows long but not all the records are always populated, sometimes 3 of the rows are populated, sometimes 8, sometimes all, only the rows that are populated need to go into access....any ideas how to do this?
example-in-trans.xlsx
LVL 1
k1ng87Asked:
Who is Participating?
 
BusyMamaConnect With a Mentor Commented:
You can use VBA to send your Excel data into Access.  I have used this method several times and I absolutely love it - no more copying and pasting!

Here is a really good link, if you have any questions while you are trying it I'd be happy to help out.

http://www.exceltip.com/st/Export_data_from_Excel_to_Access_(DAO)_using_VBA_in_Microsoft_Excel/426.html
0
 
k1ng87Author Commented:
how do I skip rows that have a shaded cell in column B?
0
 
k1ng87Author Commented:
also getting a "User-defined type not defined" error at line 4 on "Dim db As Database"
Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
    Set db = OpenDatabase("C:\testenv\InHouseRouting(NEW).mdb")
    ' open the database
    Set rs = db.OpenRecordset("ROUTED_RECORDS", dbOpenTable)
    ' get all records in a table
    r = 4 ' the start row in the worksheet
    Do While Len(Range("I" & r).Formula) > 0
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("Booking#") = Range("B" & r).Value
            .Fields("VendorID") = Range("C" & r).Value
            .Fields("DateShipped") = Range("D" & r).Value
            .Fields("CarrierCode") = Range("E" & r).Value
            .Fields("ShipToLocation") = Range("F" & r).Value
            .Fields("Skids") = Range("G" & r).Value
            .Fields("Total_Weight") = Range("H" & r).Value
            .Fields("Actual/Avoided Cost") = Range("I" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub

Open in new window

0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
BusyMamaCommented:
You might have to enable the DAO Reference Library in Excel to handle the error message you are receiving.

In VB, find Tools--> Reference(s?).  I believe it's under Microsoft DAO Library, check the box.

Any shade of cell, or a particular shade?
0
 
k1ng87Connect With a Mentor Author Commented:
here is the code with changes that I made, I also added an print and save at the end...
Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, mx As Recordset, r As Long, Conn As String, x As Integer, sht As Worksheet, skip As String, tbl As QueryTable

    Set db = OpenDatabase("C:\testenv\InHouseRouting(NEW).mdb")
    ' open the database
    Set rs = db.OpenRecordset("ROUTED_RECORDS", dbOpenTable)
    ' get all records in a table
    Set mx = db.OpenRecordset("select max([booking#]) from routed_records")
    
    Set sht = Sheets("Sheet1")
    
    sht.Range("K1").CopyFromRecordset mx

'--------------------------------------
'------Column Variables ---------------
'--------------------------------------
skip = False

    For x = 4 To 21
    ' sets range
        With rs
            'column validation
           If sht.Cells(x, "B").Interior.Color = 0 Or sht.Cells(x, "I").Value = 0 Or sht.Cells(x, "I").Value = "" Then
                skip = True
            End If
            
            If skip <> True Then
                .AddNew ' create a new record
                ' add values to each field in the record
                .Fields("Booking#") = Cells(x, "B").Value
                .Fields("VendorID") = Cells(x, "C").Value
                 Debug.Print Cells(x, "E").Value
                .Fields("DateShipped") = Cells(x, "D").Value
                .Fields("CarrierCode") = Cells(x, "E").Value
                .Fields("ShipToLocation") = Cells(x, "F").Value
                .Fields("Skids") = Cells(x, "G").Value
                .Fields("Total_Weight") = Cells(x, "H").Value
                .Fields("Actual/Avoided Cost") = Cells(x, "I").Value
                .Update ' stores the new record
            End If
            skip = False
        End With
    Next
    
skip = False

Set rs = db.OpenRecordset("CROSSDOCK_IN", dbOpenTable)
Dim i As Integer

    For i = 28 To 42
    ' sets range
        With rs
            'column validation
            If sht.Cells(i, "B").Value = "" Then
                skip = True
            End If
            
            If skip <> True Then
                .AddNew ' create a new record
                ' add values to each field in the record
                .Fields("Book#") = Cells(i, "B").Value
                .Fields("VendorID") = Cells(i, "C").Value
                .Fields("Lane") = Cells(i, "D").Value
                                Debug.Print Cells(i, "E").Value
                .Fields("@ Dock") = Cells(i, "E").Value
                .Fields("Skids") = Cells(i, "F").Value
                .Fields("Total_Weight") = Cells(i, "G").Value
                .Update ' stores the new record
            End If
            skip = False
        End With
    Next
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
    
Application.ActivePrinter = "\\USPG2-PSERV-P1\3BP03-HJLP3500C on Ne01:"
sht.PrintOut
    
            '---COPYS WORKSHEET TO NEW WORKBOOK
            sht.Select
            sht.Activate
            sht.Copy
            
            'SETS NEW WORKBOOK ACTIVE
            
            Set wbNew = ActiveWorkbook
            With wbNew
    
            '---COPY ---> PASTE VALUES THROUGH WORKSHEETS ---
        
            Sheets("Sheet1").Select
            Cells.Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            
            ActiveWorkbook.SaveAs Filename:="C:\testenv\" & "TESTVENDOR" & sht.Range("h1") & ".xls", FileFormat:=xlNormal
            
            ActiveWorkbook.Close (True)
            
            End With
End Sub

Open in new window

0
 
BusyMamaCommented:
Is it working, or where are the errors now?
0
 
k1ng87Author Commented:
the link helped me develop the code
0
All Courses

From novice to tech pro — start learning today.