UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Use Access To Open Excel File Find Last Column And Copy/paste, Access 2016    
 
   
aggiemarine07
post Sep 11 2019, 12:56 PM
Post#1



Posts: 70
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?

CODE
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
    rngUsed.Copy
    .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With

Call GetLastRow("MainSheet", "A")

wbExported.Close

wbAllData.Save
wbAllData.Close

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

Kill strFilePath

End Function
Go to the top of the page
 
June7
post Sep 11 2019, 04:04 PM
Post#2



Posts: 968
Joined: 25-January 16



Surely they will run out of columns eventually or the workbook will become so huge as to be unmanageable. Or does process start all over with a blank workbook each year?

Are you certain that DA and DB will never be used for new columns? Don't really see benefit to copying columns. Don't you also need column A info for import? Provide a sample of worksheet data.

Why not delete unneeded columns then link or import to update local tables? Review https://access-programmers.co.UK/forums/sho...ad.php?t=202957
This post has been edited by June7: Sep 11 2019, 04:05 PM

--------------------
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
 
aggiemarine07
post Sep 11 2019, 04:05 PM
Post#3



Posts: 70
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?

CODE
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
    Selection.Copy
    Range("CA:CB").Select
    ActiveSheet.Paste

wb.Save
xl.Quit
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
 
June7
post Sep 11 2019, 05:17 PM
Post#4



Posts: 968
Joined: 25-January 16



Don't have your Last function so got this to work for me.

CODE
With ws
    r = .Cells(.Rows.Count, "A").End(xlUp).Row
    c = .Cells(1, .Columns.Count).End(xlToLeft).Column
    .Range(.Cells(1, c - 1), .Cells(r, c)).Copy (.Range("CA1"))
End With


Or don't even need last row.
CODE
With ws
    c = .Cells(1, .Columns.Count).End(xlToLeft).Column
    .Range(.Columns(c - 1), .Columns(c)).Copy (.Range("CA1"))
End With


This post has been edited by June7: Sep 11 2019, 05:42 PM

--------------------
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
 
June7
post Sep 11 2019, 10:06 PM
Post#5



Posts: 968
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:

CODE
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
 
ADezii
post Sep 12 2019, 06:59 AM
Post#6



Posts: 2,689
Joined: 4-February 07
From: USA, Florida, Delray Beach


I created some very simple Code that will Copy the last 2 Columns within the UsedRange of a Worksheet (Sheet1 for this Demo) to Columns DA:DB of the same Worksheet. It can easily be adapted to suit your specific needs.
CODE
Dim intLastCol As Integer
Dim sht As Excel.Worksheet

Set sht = ActiveWorkbook.Worksheets("Sheet1")

With sht
  .Activate

   intLastCol = .UsedRange.SpecialCells(xlCellTypeLastCell).Column

   'Select the next-to-last Column and the last Column
  .Range(Chr$(intLastCol + 64 - 1) & ":" & Chr$(intLastCol + 64)).Select

   Application.Selection.Copy

  .Range("DA:DB").Select
  .Paste
End With

This post has been edited by ADezii: Sep 12 2019, 07:02 AM
Go to the top of the page
 
June7
post Sep 12 2019, 12:38 PM
Post#7



Posts: 968
Joined: 25-January 16



Did you see post 4? It is not necessary to actually Select cells to do copy. However, your method to find last column may be more efficient.

This post has been edited by June7: Sep 12 2019, 12:40 PM

--------------------
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
 
ADezii
post Sep 12 2019, 01:33 PM
Post#8



Posts: 2,689
Joined: 4-February 07
From: USA, Florida, Delray Beach


As you wish:
CODE
Dim intLastCol As Integer
Dim sht As Excel.Worksheet

Set sht = ActiveWorkbook.Worksheets("Sheet1")

With sht
  .Activate

   intLastCol = .UsedRange.SpecialCells(xlCellTypeLastCell).Column

  .Range(Chr$(intLastCol + 64 - 1) & ":" & Chr$(intLastCol + 64)).Copy
  
  .Range("DA:DB").PasteSpecial xlPasteAll
End With

P.S. - One very important point to keep in mind is that this Code will work only if the Last Column in the UsedRange does not exceed 'Z'. If the Last Column with Data is AA, AB, AC, etc., different Code will be needed to retrieve the Last, and preceding Columns.
Go to the top of the page
 
June7
post Sep 12 2019, 02:08 PM
Post#9



Posts: 968
Joined: 25-January 16



OP already stated data will likely be beyond column Z.

I tested the UsedRange code and it worked just fine when last column is beyond Z with my version for specifying copy range.

Problem with Paste is that copied range remains selected with dashed line so need to use:

Application.CutCopyMode = False

Again, no need for Paste method. Copy can be done with a one-liner.



--------------------
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
 
aggiemarine07
post Sep 24 2019, 09:11 AM
Post#10



Posts: 70
Joined: 7-January 11



hey everyone, im so sorry it has taken me so long to reply back (some personal stuff came up that required me to take time off and then I had to spend a few days catching up at work once I got back). I am back now and can answer all of yalls questions though! smile.gif

@June7 - we get this report from another company where they generate this thing manually :-/ so since its external to us I cant really control how its formatted but that is the pattern that they will follow. The sheet will start over every year. Also the column headers in the excel file are not static or predictable as they are date ranges from when they pull the report (another annoyance as I am trying to automate this process within my department).
I am little confused about where to replace your code with my own though, can you advise how the new code should look? I am definitely a fan of the simplicity of it.

@Adezii - thanks for the code to try out! Where should I implement it? I tried replacing mine with yours and I think yours requires the workbook to already be open correct? Would I need to add something that opens the workbook and then run your code?

Thanks again for all of yalls help!
Go to the top of the page
 
June7
post Sep 24 2019, 02:44 PM
Post#11



Posts: 968
Joined: 25-January 16



My code replaces everything between Set ws and wb.Close.

This post has been edited by June7: Sep 24 2019, 02:44 PM

--------------------
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
 
aggiemarine07
post Sep 25 2019, 01:46 PM
Post#12



Posts: 70
Joined: 7-January 11



@June7 - I get put your code inside of mine and get a "copy method of range class failed" on the .Range line of your code.

CODE
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")

With ws
    r = .Cells(.Rows.Count, "A").End(xlUp).Row
    c = .Cells(1, .Columns.Count).End(xlToLeft).Column
    .Range(.Cells(1, c - 1), .Cells(r, c)).Copy (.Range("CA7"))
End With

wb.Save
xl.Quit
Set xl = Nothing

'DoCmd.SetWarnings True

MsgBox "import complete"
End Sub

This post has been edited by aggiemarine07: Sep 25 2019, 01:46 PM
Go to the top of the page
 
June7
post Sep 25 2019, 02:25 PM
Post#13



Posts: 968
Joined: 25-January 16



Crud! Now it is not working for me. I am sure it did before.
This post has been edited by June7: Sep 25 2019, 02:50 PM

--------------------
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
 
June7
post Sep 25 2019, 04:14 PM
Post#14



Posts: 968
Joined: 25-January 16



Tested code in Excel and it works. Really thought I tested it before in Access but apparently did not.

Now in Access this line will work:

.Range(.Cells(1, c - 1), .Cells(r, c)).Select

So why Range copy fails is baffling.

Tried Paste and this works:

CODE
    .Range(.Cells(1, c - 1), .Cells(r, c)).Copy
    .Range("H1").PasteSpecial xlPasteAll
    .Range("A1").Select
    xl.CutCopyMode = False


So there is something about specifying destination in one-liner that Access VBA doesn't like.

This post has been edited by June7: Sep 25 2019, 04:26 PM

--------------------
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
 
aggiemarine07
post Sep 26 2019, 07:21 AM
Post#15



Posts: 70
Joined: 7-January 11



@june7 - no worries, sometime I test stuff out extensively only for it to fail as soon as I send the email to someone saying its perfect smile.gif

I actually did end of getting it working by reviewing an example on the microsoft documentation website for .Range (and I actually learned some things too!) Below is my final working code:

CODE
Private Sub Command0_Click()
'DoCmd.SetWarnings False

Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = New Excel.Application
Set xlWB = xlApp.Workbooks.Open(CurrentProject.Path & "\WFM Liability Report.xlsx")

With xlWB.Sheets("Private Label")

    r = .Cells(.Rows.Count, "A").End(xlUp).Row
    c = .Cells(7, .Columns.Count).End(xlToLeft).Column
    .Range(.Columns(c - 1), .Columns(c)).Copy
    .Columns("DA").PasteSpecial xlPasteValues
    .Range("DA6").Value = "Remaining Liable Quantity"
    .Range("DB6").Value = "Remaining Liable Dollars"
    .Range("W6").Value = "UNFI Status"
    .Range("A5").Copy
    .Range("DC7").PasteSpecial xlPasteValues
    .Range("DC7:DC" & r).FillDown
    .Range("1:5").Delete
    
End With
xlWB.Save
xlApp.Quit

Set xlWB = Nothing
Set xlApp = Nothing

'DoCmd.SetWarnings True

MsgBox "import complete"
End Sub


Thanks for all your help!
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    18th November 2019 - 02:05 AM