Import used range between columns in excel into Access 1

[JimLes]

Here is some code that I used on a previous project. I need to modify this to only pull the used range between columns A and AR. Also, I need to import from a specific worksheet named DataEntry. Should I use a named range in my excel workbook? Any help is greatly appreciated. Thx!

Public Sub ImportSeveranceData()
Dim strCurrProjPath As String
Dim objExcel As Object 'Excel.Application
Dim objWorkbook As Object 'Excel.Workbook
Dim objWorksheet As Object 'Worksheet
Dim strXlFileName As String 'Excel Workbook name
Dim strWorksheetName As String 'Excel Worksheet name
Dim objCell As Object 'Last used cell in column
Dim strUsedRange As String 'Used range
Dim FileName As String
Dim objDialog, boolResult

Set objDialog = CreateObject("UserAccounts.CommonDialog")

objDialog.Filter = "Excel Files|*.xlsm|All Files|*.*"
objDialog.FilterIndex = 1

boolResult = objDialog.ShowOpen

If boolResult = 0 Then
Exit Sub
Else

'Assign Path and filename of XL file to variable
strXlFileName = objDialog.FileName

'Assign Excel application to a variable
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False 'Can be visible or not visible
objExcel.UserControl = True

'Open the Excel Workbook
Set objWorkbook = objExcel.Workbooks.Open(strXlFileName)

'Assign required worksheet to a variable
With objWorkbook
Set objWorksheet = .Worksheets(1)
End With

With objWorksheet
'Assign worksheet name to a string variable
strWorksheetName = .Name

'Delete the first two rows in the spreadsheet down to Headers
objWorksheet.Range("A1").EntireRow.Delete
'objExcel.Selection.Delete
objWorkbook.Save

'Find last used cell in Column A
Set objCell = .Cells(.Rows.Count, "A").End(xlUp)
End With

'Assign used range to a string variable.
strUsedRange = objWorksheet.UsedRange.Address(0, 0)
'Turn off/Close in reverse order to setting/opening.
Set objCell = Nothing
Set objWorksheet = Nothing

'SaveChanges = False suppresses save message
objWorkbook.Close SaveChanges:=False
Set objWorkbook = Nothing
objExcel.Quit
Set objExcel = Nothing

'Import the worksheet
DoCmd.TransferSpreadsheet acImport, 8, "tblSeveranceData", _
strXlFileName, True, strWorksheetName & "!" & strUsedRange

End If
MsgBox "Attendance data imported successfully!"
End Sub

 

[bubba100]

Here is your answer from your code.

'Import the worksheet
DoCmd.TransferSpreadsheet acImport, 8, "tblSeveranceData", _
strXlFileName, True, strWorksheetName & "!" & strUsedRange

DoCmd.TransferSpreadsheet acImport, 8, "Table 1", "C:\Archive\File Directory.xls", True, "Sheet1!a1:e400"

Here is a way for it work.

 

[SkipVought]

Jim,

BTW, the term used range has a very specific meaning in Excel VBA.

For instance if I have a sheet that has an "x" in B4 and some shading in D9 -- NOTHING ELSE ON THE SHEET...

then

MsgBox ActiveSheet.UsedRange.Cells.Count

displays 18, since the used range is B49, 6 rows x 3 columns, is 18 cells in the Used Range.



Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[JimLes]

Hey Skip, thanks for the reply. The current code I am using only pulls the data down to the last row with data in it.

I need to tweak this code to only pull data down to the last row with data in it between columns A and AR.

Does that make better sense?

I have been experimenting with creating a named dynamic range using VBA to change this code:
'Assign used range to a string variable.
strUsedRange = objWorksheet.UsedRange.Address(0, 0)

to something more like this:

'Assign used range to a string variable.
strUsedRange= objWorkbook.Range(A2).OFFSET (DataEntry!$A$2,0,0,COUNTA(DataEntry!$A:$A),34)

VB doesn't like this too much. I also created a dynamic range in the workbook using the offset but VBA won't pick it up.

 

[SkipVought]

'last row with data in it between columns A and AR
dim rUsed as range

set rUsed = intersect(range("A:AR"),activesheet.UsedRange)

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[JimLes]

Thanks Skip, forgive my noobness. I am trying to fit your code into mine but I am getting a object reference error. Any ideas?


Dim strUsedRange As String 'Used range
Dim rUsed As Range

'Assign used range to a string variable.
Set rUsed = Intersect(Range("A:AH"), ActiveSheet.UsedRange)
strUsedRange = rUsed

'Import the worksheet
DoCmd.TransferSpreadsheet acImport, 8, "tblSeveranceData", _
strXlFileName, True, strWorksheetName & "!" & strUsedRange

 

[SkipVought]

    strUsedRange = rUsed[b].address[/b]

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Remou]

It is not too difficult to execute a query against the current connection:

sSQL="Select * Into NewTable From " _
& "[Sheet1$A1:C15] IN '' [Excel 8.0;HDR=YES;IMEX=2;DATABASE=C:\Docs\LTD.xls]"

http://lessthandot.com

 

[JimLes]

Skip,

The code worked but I am getting blank rows, I believe to be caused by conditional formulas and validation in the cells. Is there any to use the OFFSET method to create a dynamic range in VBA? I have been searching on how to do this but can't apply it.

 

[SkipVought]

Please post all the code you are using relative to the Excel object.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[JimLes]

Hey Skip, I used a dynamic named range in my workbook that changes when it is closed. This code fails because it cannot find the object.

I am open to using a dynamic named range but would prefer to do it all in VBA.

Thanks, Jim

Public Sub ImportSeveranceData()
Dim strCurrProjPath As String
Dim objExcel As Object 'Excel.Application
Dim objWorkbook As Object 'Excel.Workbook
Dim objWorksheet As Object 'Worksheet
Dim strXlFileName As String 'Excel Workbook name
Dim strWorksheetName As String 'Excel Worksheet name
Dim objCell As Object 'Last used cell in column
Dim strUsedRange As String 'Used range
Dim FileName As String
Dim objDialog, boolResult
Dim rUsed As Range

Set objDialog = CreateObject("UserAccounts.CommonDialog")

objDialog.Filter = "Excel Files|*.xls|All Files|*.*"
objDialog.FilterIndex = 1

boolResult = objDialog.ShowOpen

If boolResult = 0 Then
Exit Sub
Else

'Assign Path and filename of XL file to variable
strXlFileName = objDialog.FileName

'Assign Excel application to a variable
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False 'Can be visible or not visible
objExcel.UserControl = True

'Open the Excel Workbook
Set objWorkbook = objExcel.Workbooks.Open(strXlFileName)

'Assign required worksheet to a variable
With objWorkbook
Set objWorksheet = .Worksheets("DataEntry")
End With

With objWorksheet
'Assign worksheet name to a string variable
strWorksheetName = .Name

'Delete the first row in the spreadsheet down to Headers
'objWorksheet.Range("A1").EntireRow.Delete
'objExcel.Selection.Delete
'objWorkbook.Save

'Find last used cell in Column A
'Set objCell = .Cells(.Rows.Count, "A").End(xlUp)
End With

'Assign used range to a string variable.
Set rUsed = Worksheets("DataEntry").Range("DataStatic") 'Intersect(Range("A:H"), ActiveSheet.UsedRange)
strUsedRange = rUsed.Address
'objWorksheet.UsedRange.Address(0, 0)
'strUsedRange = rUsed.Address
'Worksheets("DataEntry").Range("Data")

'Turn off/Close in reverse order to setting/opening.
Set objCell = Nothing
Set objWorksheet = Nothing

'SaveChanges = False suppresses save message
objWorkbook.Close SaveChanges:=False
Set objWorkbook = Nothing
objExcel.Quit
Set objExcel = Nothing

'Import the worksheet
DoCmd.TransferSpreadsheet acImport, 8, "tblSeveranceData", _
strXlFileName, True, strWorksheetName & "!" & strUsedRange

End If
MsgBox "Attendance data imported successfully!"
End Sub

 

[SkipVought]

Specifically what statement does it fail on?

Please sxplain exactly what "This code fails because it cannot find the object," means.

How do you know that it cannot find the object?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[JimLes]

Skip, it is failing on the dynamic range. I thought I had it figured out but I get the message below:

"The microsoft database engine could not find the object "DataEntry$$A$2:$AH$6'". Make sure the object exists and you spelled the name and path correctly."


Here is the code I think where it is failing:
Set rUsed = Worksheets("DataEntry").Range("DataStatic") 'Intersect(Range("A:H"), ActiveSheet.UsedRange)
strUsedRange = rUsed.Address

 

[SkipVought]

Well which is it? You posted TWO statements?

Why are you even storing the address? Its pointless!

If your range is on some other sheet then...

With Worksheets("DataEntry")
   Set rUsed = Intersect(.Range("A:H"), .UsedRange)
End With

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[JimLes]

Okay, I managed to get it to work. I found out that Access 2003 cannot import a dynamic range from excel so the workaround is to create a static range in the worksheet before closing. All I needed to do was to tweak the TransferSpreadsheet method to pull the named range. Here is the code I used to create the dynamic range between columns A and AH identifying only the rows with data:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lastRow As Long
Dim Range1 As Range
lastRow = Sheet1.Range("A65536").End(xlUp).Row
'Table begins at cell A2 and has 34 columns
Set Range1 = Sheet1.Range("A2").Resize(lastRow - 1, 34)
Range1.Name = "DynamicRange"
Set Range1 = Nothing
End Sub

Next Step was to import the named static range into access. This code enables the user to pull in a the worksheet from a dialog box and pull only that static range from that sheet:

Public Sub ImportSeveranceData()
Dim strCurrProjPath As String
Dim objExcel As Object 'Excel.Application
Dim objWorkbook As Object 'Excel.Workbook
Dim objWorksheet As Object 'Worksheet
Dim strXlFileName As String 'Excel Workbook name
Dim strWorksheetName As String 'Excel Worksheet name
Dim objCell As Object 'Last used cell in column
Dim strUsedRange As String 'Used range
Dim FileName As String
Dim objDialog, boolResult


Set objDialog = CreateObject("UserAccounts.CommonDialog")

objDialog.Filter = "Excel Files|*.xls|All Files|*.*"
objDialog.FilterIndex = 1

boolResult = objDialog.ShowOpen

If boolResult = 0 Then
Exit Sub
Else

'Assign Path and filename of XL file to variable
strXlFileName = objDialog.FileName

'Assign Excel application to a variable
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False 'Can be visible or not visible
objExcel.UserControl = True

'Open the Excel Workbook
Set objWorkbook = objExcel.Workbooks.Open(strXlFileName)

'Assign required worksheet to a variable
With objWorkbook
Set objWorksheet = .Worksheets(1)
End With

With objWorksheet
'Assign worksheet name to a string variable
strWorksheetName = .Name

End With


'Turn off/Close in reverse order to setting/opening.
Set objCell = Nothing
Set objWorksheet = Nothing

'SaveChanges = False suppresses save message
objWorkbook.Close SaveChanges:=False
Set objWorkbook = Nothing
objExcel.Quit
Set objExcel = Nothing

'Import the worksheet
DoCmd.TransferSpreadsheet acImport, 8, "tblSeveranceData", _
strXlFileName, True, "DynamicRange"

End If
MsgBox "Attendance data imported successfully!"
End Sub


To all users, this code works but you have to make sure you create a static range in excel first using the VB code above.