• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 83
  • Last Modified:

How to insert the result of excel code to access

I need to insert the results from the below code  in Access file because of the excel sheet limitation.

Regards,

Dallag

Sub ReArrangeDataVersion4()
Dim sws As Worksheet, dws As Worksheet
Dim lr As Long, lc As Long, i As Long, dlr As Long
Dim x, y
Dim TimeTaken As Date
TimeTaken = Now
Application.ScreenUpdating = False
Set sws = Sheets("Sheet1")
Set dws = Sheets("Output")

lr = sws.Cells(Rows.Count, 1).End(xlUp).Row
lc = sws.Cells(1, Columns.Count).End(xlToLeft).Column

dlr = dws.Cells(Rows.Count, 2).End(xlUp).Row
If dlr > 1 Then dws.Range("A2:G" & dlr).Clear
y = sws.Range("A4:A" & lr).Value

For i = 2 To lc Step 8
   DoEvents
   dlr = dws.Range("B" & Rows.Count).End(3)(2).Row
   dws.Range("B" & dlr).Offset(0, -1) = sws.Cells(1, i)
   dws.Range("B" & dlr).Resize(UBound(y, 1)).Value = y
   x = sws.Range(sws.Cells(4, i), sws.Cells(lr, i + 7)).Value
   dws.Range("C" & dlr).Resize(UBound(y, 1), 8).Value = x
Next i
dlr = dws.Cells(Rows.Count, 2).End(xlUp).Row
dws.Range("A2:A" & dlr).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
dws.Range("A2:A" & dlr).Value = dws.Range("A2:A" & dlr).Value
dws.Columns.AutoFit
dws.Range("A1").CurrentRegion.Borders.Color = vbBlack
dws.Activate
Application.ScreenUpdating = True
MsgBox "Time taken to process data was " & Format(Now - TimeTaken, "hh:mm:ss")
End Sub

Open in new window

0
Mohammed Dallag
Asked:
Mohammed Dallag
1 Solution
 
BitsqueezerCommented:
Hi,

what do you expect should be the answer for this question?

Nobody knows what your Excel sheet contains. Because of that nobody knows what data is manipulated in which way. And nobody knows what's in your Access file and how the data from the Excel file has a logical relationship to it or what should be done in the Access file.

If you want to get an answer it's on your turn to give all needed information.

Cheers,

Christian
0
 
COACHMAN99Commented:
you need to
1. create an ODBC connection to the database
2. declare and open an ADO connection (using the ODBC connection) to the Access database, (outside the loop)
3. then run INSERT statements in your loop
4. then close the connection
0
 
Mohammed DallagPetroleum ConsultantAuthor Commented:
I attached the excel sheet and the access file.

Regards,

Dallag
ReArrangeData_V41.xlsm
1.accdb
0
 
Helen FeddemaCommented:
This code will do it:

Public Sub ImportXLData()
'Created by Helen Feddema 6-Oct-2016
'Last modified by Helen Feddema 6-Oct-2016

On Error GoTo ErrorHandler

   Dim appExcel As New Excel.Application
   Dim strWorkbook As String
   Dim strTable As String
   Dim wkb As Excel.Workbook
   Dim strSQL As String
   Dim strSpec As String
   
   strWorkbook = Application.CurrentProject.Path & "\ReArrangeData_V41.xlsm"
   Debug.Print "XL file: " & strWorkbook
   Set wkb = appExcel.Workbooks.Open(strWorkbook)
   strTable = "txlsOutput"
   strSQL = "DELETE * FROM " & strTable
   CurrentProject.Connection.Execute strSQL
   
   strSpec = "Import-ReArrangeData_V41"
   Application.CurrentProject.ImportExportSpecifications(strSpec).Execute

ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   MsgBox "Error No: " & Err.Number _
      & " in ImportXLData procedure; " _
      & "Description: " & Err.Description
   Resume ErrorHandlerExit

End Sub

Open in new window


I first made the export spec manually.  

You will need to delete the first row, with the imported headings -- there is an error because one of the Excel column headings is not a valid Access field name, so I redid the names.  I am attaching the database with a module containing this code.
HBF-Modified-1.accdb
0
 
Mohammed DallagPetroleum ConsultantAuthor Commented:
Thank you
0

Featured Post

Take Control of Web Hosting For Your Clients

As a web developer or IT admin, successfully managing multiple client accounts can be challenging. In this webinar we will look at the tools provided by Media Temple and Plesk to make managing your clients’ hosting easier.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now