Solved

Opening Excel Workbooks with VBA

Posted on 2012-03-14
7
350 Views
Last Modified: 2012-08-13
I have a form that's opening excel (if it's not already open), opening two seperate workbooks then looping through ranges to copy and paste values from one workbook to the other. This works fine if I don't have another instance of excel open and if I run the code once then open another instance of excel.

Issue: If I have an excel workbook open then run the code, the loop statement doesn't have an end point (loop continues on until accessis blown off).

I've provided an example. To keep this as simple as possible I have stripped out all unnecessary data and provided the three excel files the program is using. To test save all files to your C drive.

Any help here is appreciated. Thank you!
Dump.xlsx
Equity-Pipeline.xlsx
Equity-Template.xlsx
Experts-Test.mdb
0
Comment
Question by:twands
  • 2
  • 2
  • 2
7 Comments
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 37722137
So this is being done through MS Access?

Seems like more of an Excel Question, but you posted it to the Access zone...?

JeffCoachman
0
 

Author Comment

by:twands
ID: 37722176
Yes. I'm opening ExcelObjects but in Access VBA. Should I also post this question under Excel?
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 37722245
No, I was just wondering if this was an Excel Q or an Access Q.

But it would not hurt to request that the Excel zone be added...

;-)

Jeff
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 41

Expert Comment

by:dlmille
ID: 37723361
I'm not surprised you're having difficulties, and I would note a few constructive points that should help.

You have a couple key statements:
    Set objWB1 = ExcelObject.Application.Workbooks.Open(sFile2)
    Set objWB2 = ExcelObject.Application.Workbooks.Open(sFile)

but then you start using Windows(excelfile).activate and you start directly reference sheet objects which have no parent, etc.

To control Excel, you must start with the Application Object, then Workbook Object, then Worksheet Object, then Range Object (for example).

So, heres a few statements in your code, but you have not referenced who owns the Cells, who owns the Sheets, etc.
Do Until IsEmpty(Cells(1, iCol))

objWB1.Sheets(1).Activate


    'copying the property name
    'objWB2.Sheets(1).Activate
    Windows("Dump.xlsx").Activate
    Sheets(1).Cells(1, iCol).Select
    Selection.Copy
    'objWB1.Sheets(1).Activate
    Windows("Equity Template.xlsx").Activate
    Sheets(1).Cells(8, iCol2).Select
    Selection.PasteSpecial xlPasteValues

Open in new window


This particular snippet should be written something like:
dim wks1 as Excel.Worksheet
dim wks2 as Excel.Worksheet
dim r as Excel.Range

set wks1= objWB1.Sheets(1)
set wks2 = objWB2.Sheets(1)

Do Until IsEmpty(wks1.Cells(1, iCol))

    'copying the property name
 
    wks2.Cells(1, iCol).Select
    Selection.Copy

    'objWB1.Sheets(1).Activate
    'Windows("Equity Template.xlsx").Activate

'Activate Workbook 1 as follows
'objWB1.Activate '<- this is the correct syntax

    wks1.Cells(8, iCol2).Select
    Selection.PasteSpecial xlPasteValues

Open in new window


Written again, optimized:
Dim wks1 As Excel.Worksheet
Dim wks2 As Excel.Worksheet
Dim r As Excel.Range

Set wks1 = objWB1.Sheets(1)
Set wks2 = objWB2.Sheets(1)

Do Until IsEmpty(wks1.Cells(1, iCol))

    'copying the property name
 
    wks2.Cells(1, iCol).Copy

    wks1.Cells(8, iCol2).PasteSpecial xlPasteValues

Open in new window


So, go through your code and ensure all your variables that reference excel object have ownership from the Application, to the Workbook, Sheet, then Range/Cell.

Hope this helps.

Dave
0
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
ID: 37723373
Here.  I think I got you half-way.  I wish I had renamed objWB1 to objEquity and objWB2 to objDummy as it would have helped, but check my work, and I think from this you should be ablel to finish out the rest ;)

Option Compare Database

Private Sub cmdEquity_Click()
On Error GoTo Err_cmdEquity_Click

    Dim sFile As String
    Dim sFile2 As String
    Dim ExcelObject As Excel.Application
    Dim sNewName As String
    Dim objWB1 As Excel.Workbook
    Dim objWB2 As Excel.Workbook
    Dim objWS1 As Excel.Worksheet
    Dim objWS2 As Excel.Worksheet
    
On Error Resume Next
    ' if excel is already open it uses that instance
    Set ExcelObject = GetObject(, "Excel.Application")

    ' if excel isn't open, it opens a new instance of excel
    If ExcelObject Is Nothing Then
        Set ExcelObject = New Excel.Application
        ExcelObject.EnableEvents = False
    End If
    

    'open excel shell file
    sFile2 = "C:\Equity Template.xlsx"
    sFile = "C:\Dump.xlsx"
    
    
    Set objWB1 = ExcelObject.Application.Workbooks.Open(sFile2) 'equity
    Set objWB2 = ExcelObject.Application.Workbooks.Open(sFile) 'dump
    
   'set the mouse pointer to an hourglass(wheel)
   SavedPointer = Screen.MousePointer
   Screen.MousePointer = 11

Dim iCol As Integer
Dim iCol2 As Integer

iCol = 3
iCol2 = 4

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'copy over all the values to the 0-6 month tab of the template

Set objWS1 = objWB1.Sheets(1) 'equity
Set objWS2 = objWB2.Sheets(1) 'dump

Do Until IsEmpty(objWS2.Cells(1, iCol)) 'must be WB2 - last file opened

objWB1.Sheets(1).Activate


    'copying the property name
    
    objWS2.Cells(1, iCol).Copy
    objWS1.Cells(8, iCol2).PasteSpecial xlPasteValues
    
    'copying the city, state, zip, couty
    objWS2.Range(objWS2.Cells(3, iCol), objWS2.Cells(7, iCol)).Copy
    objWS1.Range(objWS1.Cells(9, iCol2), objWS1.Cells(13, iCol2)).PasteSpecial xlPasteValues
    
    'copying the units
    objWS2.Cells(8, iCol).Copy
    objWS1.Cells(15, iCol2).PasteSpecial xlPasteValues
    
    'copying project type section
    objWS2.Range(objWS2.Cells(9, iCol), objWS2.Cells(12, iCol)).Copy
    objWS1.Range(objWS1.Cells(17, iCol2), objWS1.Cells(20, iCol2)).PasteSpecial xlPasteValues

    'copying contact section
    objWS2.Range(objWS2.Cells(14, iCol), objWS2.Cells(16, iCol)).Copy
    objWS1.Range(objWS1.Cells(22, iCol2), objWS1.Cells(25, iCol2)).PasteSpecial xlPasteValues
    
    'copying tax credit section
    objWS2.Range(objWS2.Cells(18, iCol), objWS2.Cells(27, iCol)).Copy
    objWS1.Range(objWS1.Cells(27, iCol2), objWS1.Cells(36, iCol2)).PasteSpecial xlPasteValues
    
    'copying rehab section
    objWS2.Cells(29, iCol).Copy
    objWS1.Cells(39, iCol2).PasteSpecial xlPasteValues
    
    'copying demographic section
    objWS2.Range(objWS2.Cells(31, iCol), objWS2.Cells(35, iCol)).Copy
    objWS1.Range(objWS1.Cells(42, iCol2), objWS1.Cells(46, iCol2)).PasteSpecial xlPasteValues
    
    'copying subsidy section
    objWS2.Range(objWS2.Cells(37, iCol), objWS2.Cells(41, iCol)).Copy
    objWS1.Range(objWS1.Cells(49, iCol2), objWS1.Cells(53, iCol2)).PasteSpecial xlPasteValues

    'copying project section
    objWS2.Range(objWS2.Cells(43, iCol), objWS2.Cells(51, iCol)).Copy
    objWS1.Range(objWS1.Cells(56, iCol2), objWS1.Cells(64, iCol2)).PasteSpecial xlPasteValues

    iCol = iCol + 1
    iCol2 = iCol2 + 1
    
Loop


'delete all the blank columns at the end of the sheet
iCol2 = 8

    Do Until objWS1.Cells(8, iCol2).Interior.ColorIndex <> 37
    
        objWS1.Columns(iCol2).Delete Shift:=xlLeft
        
    Loop

'convert all the unit totals to numbers
    iCol2 = 4
    Dim Val As String
    
    Do Until IsEmpty(objWS1.Cells(15, iCol2))
    
        objWS1.Cells(15, iCol2).NumberFormat = "General"
        objWS1.Cells(15, iCol2).Value = objWS1.Cells(15, iCol2).Value
        
        'Val = ActiveCell.Value
        'ActiveCell.Value = Val
        
        iCol2 = iCol2 + 1
        
    Loop
'convert all the tax credit alloc cells to numbers
    iCol2 = 4
    Do Until IsEmpty(objWS1.Cells(28, iCol2))
    
        objWS1.Cells(28, iCol2).NumberFormat = "General"
        objWS1.Cells(28, iCol2).Value = objWS1.Cells(28, iCol2).Value
        
        'Val = ActiveCell.Value
        'ActiveCell.Value = Val
        
        iCol2 = iCol2 + 1
        
    Loop
    
'ExcelObject.Application.Workbooks("Dump.xlsx").Close
objWS2.Close savechanges:=False

Open in new window


Don't hesitate to post if you need additional help.

Cheers,

Dave
0
 

Author Closing Comment

by:twands
ID: 37724895
YES!! Thank you, this works perfectly!
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

PaperPort has a feature called the "Send To Bar". It provides a convenient, drag-and-drop interface for using other installed software, such as Microsoft Office. However, this article shows that the latest Office 2016 apps (installed with an Office …
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

747 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

11 Experts available now in Live!

Get 1:1 Help Now