Solved

How to insert the result of excel code to access

Posted on 2016-09-28
6
51 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:dallagmm
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:dallagmm
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:dallagmm
ID: 41871836
Thank you
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

The first two articles in this short series — Using a Criteria Form to Filter Records (http://www.experts-exchange.com/A_6069.html) and Building a Custom Filter (http://www.experts-exchange.com/A_6070.html) — discuss in some detail how a form can be…
When you are entering numbers in a speadsheet, and don't remember what 6×7 is, you just type “=6*7" instead. It works in every cell! This is not so in Access. To enter the elusive 42 in a text box, you have to find a calculator, and then copy the re…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

762 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

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now