How to import Excel Sheets to Access. Each sheet to begin on Row 1

[debq]

I have found a solution to open Excel, Choose an specific excel sheet based on input on a listbox form from a user and import the data from the selected Sheet to an Access db table. The data in the Excel sheet is based on months - Jan thru Dec. I can create the table with the months as column headers but the data for each month cascades down the table. Lines for January (JAN import in column 1 rows 1 thru 9 and then the data for February (FEB) import in rows 10 thru 18 and so no thru December.


How can I get all data for each month to start to import on the first row? I am using the autonumber on each row as the data source for the Report that displays th e data.

This is the working code. How can I tweak it to get the Jan, Feb, Mar ect. data to start on row 1???

Option Compare Database

Private Sub Command0_Click()

Dim rec As Recordset
Dim db As Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim xlApp As Object 'Excel.Application
Dim xlWrk As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.Worksheet
Dim cboText As String

cboText = [Forms]![Form1]![List3]

Set xlApp = CreateObject("Excel.Application")
Set xlWrk = xlApp.Workbooks.Open("C:\Users\p418549\Desktop\CA CMI Data 2014-12-30 by facility tabs.xlsx") 'My directory
Set xlSheet = xlWrk.Sheets(cboText)  'My sheet name
Set db = CurrentDb
Set tdf = db.CreateTableDef()
tdf.Name = "CMI_CASE_MIX_IMPORT"

'Delete the table if it exists
If TableExists("CMI_CASE_MIX_IMPORT") Then
    DoCmd.DeleteObject acTable, "CMI_CASE_MIX_IMPORT"
End If

'Create table

Set fld = tdf.CreateField("ID", dbLong, 150)
fld.OrdinalPosition = 1
fld.Attributes = dbAutoIncrField + dbVariableField
tdf.Fields.Append fld

Set fld = tdf.CreateField("JAN", dbMemo, 150)
fld.OrdinalPosition = 2
fld.Attributes = dbHyperlinkField + dbVariableField
tdf.Fields.Append fld

Set fld = tdf.CreateField("FEB", dbMemo, 150)
fld.OrdinalPosition = 4
fld.Attributes = dbHyperlinkField + dbVariableField
tdf.Fields.Append fld

Set fld = tdf.CreateField("MAR", dbMemo, 150)
fld.OrdinalPosition = 5
fld.Attributes = dbHyperlinkField + dbVariableField
tdf.Fields.Append fld

Set fld = tdf.CreateField("APR", dbMemo, 150)
fld.OrdinalPosition = 6
fld.Attributes = dbHyperlinkField + dbVariableField
tdf.Fields.Append fld

Set fld = tdf.CreateField("MAY", dbMemo, 150)
fld.OrdinalPosition = 7
fld.Attributes = dbHyperlinkField + dbVariableField
tdf.Fields.Append fld

Set fld = tdf.CreateField("JUN", dbMemo, 150)
fld.OrdinalPosition = 8
fld.Attributes = dbHyperlinkField + dbVariableField
tdf.Fields.Append fld

Set fld = tdf.CreateField("JUL", dbMemo, 150)
fld.OrdinalPosition = 9
fld.Attributes = dbHyperlinkField + dbVariableField
tdf.Fields.Append fld

Set fld = tdf.CreateField("AUG", dbMemo, 150)
fld.OrdinalPosition = 10
fld.Attributes = dbHyperlinkField + dbVariableField
tdf.Fields.Append fld

Set fld = tdf.CreateField("SEP", dbMemo, 150)
fld.OrdinalPosition = 11
fld.Attributes = dbHyperlinkField + dbVariableField
tdf.Fields.Append fld

Set fld = tdf.CreateField("OCT", dbMemo, 150)
fld.OrdinalPosition = 12
fld.Attributes = dbHyperlinkField + dbVariableField
tdf.Fields.Append fld

Set fld = tdf.CreateField("NOV", dbMemo, 150)
fld.OrdinalPosition = 13
fld.Attributes = dbHyperlinkField + dbVariableField
tdf.Fields.Append fld

Set fld = tdf.CreateField("DEC", dbMemo, 150)
fld.OrdinalPosition = 14
fld.Attributes = dbHyperlinkField + dbVariableField
tdf.Fields.Append fld


With db.TableDefs
    .Append tdf
    .Refresh
End With

Set rec = db.OpenRecordset("CMI_CASE_MIX_IMPORT")

m = 9 ' Let say your data is staring from cell E9 we will loop over column E until no data is read
Do While xlSheet.Cells(m, 5) <> ""
    rec.AddNew
    rec("JAN") = xlSheet.Cells(m, 5)
    rec.Update
    m = m + 1
Loop

m = 9
Do While xlSheet.Cells(m, 6) <> ""
    rec.AddNew
    rec("FEB") = xlSheet.Cells(m, 6)
    rec.Update
    m = m + 1
Loop

m = 9
Do While xlSheet.Cells(m, 6) <> ""
    rec.AddNew
    rec("MAR") = xlSheet.Cells(m, 7)
    rec.Update
    m = m + 1
Loop

m = 9
Do While xlSheet.Cells(m, 6) <> ""
    rec.AddNew
    rec("APR") = xlSheet.Cells(m, 8)
    rec.Update
    m = m + 1
Loop

m = 9
Do While xlSheet.Cells(m, 6) <> ""
    rec.AddNew
    rec("MAY") = xlSheet.Cells(m, 9)
    rec.Update
    m = m + 1
Loop

m = 9
Do While xlSheet.Cells(m, 6) <> ""
    rec.AddNew
    rec("JUN") = xlSheet.Cells(m, 10)
    rec.Update
    m = m + 1
Loop

m = 9
Do While xlSheet.Cells(m, 6) <> ""
    rec.AddNew
    rec("JUL") = xlSheet.Cells(m, 11)
    rec.Update
    m = m + 1
Loop

m = 9
Do While xlSheet.Cells(m, 6) <> ""
    rec.AddNew
    rec("AUG") = xlSheet.Cells(m, 12)
    rec.Update
    m = m + 1
Loop

m = 9
Do While xlSheet.Cells(m, 6) <> ""
    rec.AddNew
    rec("SEP") = xlSheet.Cells(m, 13)
    rec.Update
    m = m + 1
Loop

m = 9
Do While xlSheet.Cells(m, 6) <> ""
    rec.AddNew
    rec("OCT") = xlSheet.Cells(m, 14)
    rec.Update
    m = m + 1
Loop

m = 9
Do While xlSheet.Cells(m, 6) <> ""
    rec.AddNew
    rec("NOV") = xlSheet.Cells(m, 15)
    rec.Update
    m = m + 1
Loop

m = 9
Do While xlSheet.Cells(m, 6) <> ""
    rec.AddNew
    rec("DEC") = xlSheet.Cells(m, 16)
    rec.Update
    m = m + 1
Loop

MsgBox "Hey Debra, Your data has imported successfully!!You are very smart!!!"
End Sub

Public Function TableExists(TableName As String) As Boolean
Dim strTableNameCheck
On Error GoTo ErrorCode

'try to assign tablename value
strTableNameCheck = CurrentDb.TableDefs(TableName)

'If no error and we get to this line, true
TableExists = True

ExitCode:
    On Error Resume Next
    Exit Function

ErrorCode:
    Select Case Err.Number
        Case 3265  'Item not found in this collection
            TableExists = False
            Resume ExitCode
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "hlfUtils.TableExists"
            'Debug.Print "Error " & Err.number & ": " & Err.Description & "hlfUtils.TableExists"
            Resume ExitCode
    End Select

End Function

 

[SkipVought]

Hi,

It would be a huge mistake to create such a non-normalized table, ie months (data) as headings. It will be as much of a headache as the Excel file with separate sheets for each month.

Look at a table design which will normalize your data and make the job of analyzing and reporting so much simpler than your intended design will.

 

[debq]

I agree. I would never build data tables in this manner.... But I am pulling data from the "trusted" excel format and placing that data into a dashboard with a very specific format. I need the data to line up in a specific way so that I can reference it in my report by ID number.I am currently getting the data that I need but is is not importing to the rows as needed....