X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
> Use Access To Open Excel File Find Last Column And Copy/paste, Access 2016    
post Sep 11 2019, 12:56 PM

Posts: 67
Joined: 7-January 11

So I have a task I would like to automate. Currently a spreadsheet is emailed out each week that identifies liability of product we have however each week that the spreadsheet comes out, they add two columns to the end in order to track weekly progress.

In short, I am trying to develop some code that will grab the last two columns (which are the summary columns of all the weeks) and copy them to a far-off consistence column (i.e. copy columns AA and AB to DA and DB). This way I can consistently import the data into Access for processing and merge other data elements with this emailed spreadsheet to better inform my team but this adding of columns each week is problematic for Access and the assigned fields.

Below is the closest thing I have found online (most of the other examples have been excel specific and not access). How do I adjust the below to what I am wanting to do?

Option Compare Database

Sub GetLastRow(MyRange As Excel.Range)
    Dim lngLastRow As Long

    With MyRange.Worksheet
        lngLastRow = .Cells(.Rows.Count, MyRange.Column).End(xlUp).Row
        .Range(.Cells(lngLastRow + 1, 1), .Cells(.Rows.Count, 1)).EntireRow.Delete
    End With
End Sub

Function CreateExcelData()
'Copies data to be exported to an Excel workbook
Dim objExcel         As Excel.Application
Dim strTemplate      As String
Dim strPathFile      As String
Dim RowCount         As Integer
Dim wbExported       As Workbook  'The initial exported data
Dim wbAllData        As Workbook   'Workbook to copy exported data to
Dim rngUsed          As Range        'Used range in exported data
Dim Sheet            As Worksheet

'Try GetObject first in case Excel Application is already open.
On Error Resume Next
Set objExcel = GetObject(, "excel.Application")
If Err.Number <> 0 Then
    'GetObject returns error if not already open
    'so use CreateObject
    On Error GoTo 0 'Turnoff ASAP so error trapping is available
    Set objExcel = CreateObject("Excel.Application")
End If

strTemplate = "TEMPLATE.xlsm"
strPathFile = strPath & strTemplate
strPathFileFinal = strPath & strReportName & "_" & Mydat & ".xlsm"

FileCopy strPathFile, strPathFileFinal

'Open the exported data workbook and assign to a variable
Set wbExported = objExcel.Workbooks.Open(strFilePath)

'Open the data workbook to receive the exported data and assign to a variable.
Set wbAllData = objExcel.Workbooks.Open(strPathFileFinal)

'Exported data
With wbExported.Sheets(1).UsedRange
    Set rngUsed = .Offset(1, 0) _
        .Resize(.Rows.Count - 1, .Columns.Count)
End With

With wbAllData.Sheets("MainSheet")
    'Copy exported data and paste to first empty cell of MainSheet in File
    .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With

Call GetLastRow("MainSheet", "A")



Set rngUsed = Nothing
Set wbExported = Nothing
Set wbAllData = Nothing
Set objExcel = Nothing

Kill strFilePath

End Function
Go to the top of the page
Start new topic
post Sep 11 2019, 04:05 PM

Posts: 67
Joined: 7-January 11

Ok so I have progressed to the below but I get a "run time 1004 error: copy area and paste area arent the same size"; how do i fix this?

Private Sub Command0_Click()
'DoCmd.SetWarnings False

Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim lRowCount As Long

Dim myRange As Excel.Range

Set xl = CreateObject("Excel.Application")
strInputFile = CurrentProject.Path & "\WFM Liability Report.xlsx"
Set wb = xl.Workbooks.Open(strInputFile)
Set ws = wb.Sheets("Private Label")

    Dim LastCol As Long
    Dim rng As Range

    ' Use all cells on the sheet
    Set rng = ws.Cells

    ' Find the last column
    LastCol = Last(2, rng)

    ' After the last column with data change the value of the cell in row 1
    rng.Parent.Cells(7, LastCol - 1).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select

Set xl = Nothing

'DoCmd.RunSQL "DELETE * FROM [LiabilityReport] "
'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, _
'    "LiabilityReport", CurrentProject.Path & "\WFM Liability Report.xlsx", False, "Private Label!A7:BG1000"
'DoCmd.SetWarnings True

MsgBox "import complete"
End Sub

Go to the top of the page
post Sep 11 2019, 10:06 PM

Posts: 955
Joined: 25-January 16

Are worksheet column headers standardized so you know what the new column names would be? It is possible to pull data from Excel file without using Excel automation. Consider:

CurrentDb.Execute "INSERT INTO LiabilityReport(Field1, Field2, Field3) " & _
"SELECT Header1, Header2, Header3 " & _
"FROM [Excel 8.0;HDR=YES;IMEX=1;Database=" & CurrentProject.Path & "\WFM Liability Report.xlsx].[Private Label$] AS T1"

Dynamically setting header names in SQL statement is tricky part.

Attachments Manager is below the edit post window. To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
DEBUG! DEBUG! DEBUG! http://www.cpearson.com/Excel/DebuggingVBA.aspx
Go to the top of the page

Posts in this topic

Custom Search

RSSSearch   Top   Lo-Fi    12th November 2019 - 01:40 AM