Solved

How to insert the result of excel code to access

Posted on 2016-09-28
6
56 Views
Last Modified: 2016-11-03
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
Comment
Question by:Mohammed Dallag
6 Comments
 
LVL 24

Expert Comment

by:Bitsqueezer
ID: 41819869
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
 
LVL 7

Expert Comment

by:COACHMAN99
ID: 41820300
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
 

Author Comment

by:Mohammed Dallag
ID: 41820358
I attached the excel sheet and the access file.

Regards,

Dallag
ReArrangeData_V41.xlsm
1.accdb
0
 
LVL 31

Accepted Solution

by:
Helen_Feddema earned 500 total points
ID: 41832279
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
 

Author Closing Comment

by:Mohammed Dallag
ID: 41871836
Thank you
0

Featured Post

Back Up Your Microsoft Windows Server®

Back up all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

831 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question