Solved

Excel 2007 vb within one workbook to check if another workbook is open and either open or continue

Posted on 2011-03-07
12
248 Views
Last Modified: 2012-05-11
Hello Experts!

Back with another question.

I am using Excel 2007.  Within a specific workbook I have a macro that needs to:
 1st) check if another workbook (say wbk2) is open:
a)If it is continue on to find the last row of input from each of specific series of worksheets in wbk1 and paste the values to wbk2 on specific series of sheets
b)if not open wbk2 and then copy from wbk1 to wbk2 as in a) above.

Following is what I have.  The if then statement is where I have a problem.
Sub SaveDataInput()
    ' Add This Shifts LVL Totals for Day as of the End of Shift to LVL Total for Day Export worksheet
    '
    ' Keyboard Shortcut: Ctrl+Shift+Z
    Dim wbk As Workbook
    Dim inputRange As Range, outputRange As Range
    
    strSaveToFile = "U:\DATA\XYZ Co\Workpapers\Shift Details Data.xlsx"
  
' Begin Save info from input file LVL Total For Day Export Temp sheet to Data file LVL Total For Day Export sheet
    LastRowInput = Sheets("LVL Total For Day Export Temp").Range("A" & Rows.Count).End(xlUp).Row
    
    Set inputRange = Sheets("LVL Total For Day Export Temp").Range("A2:AC" & LastRowInput)
    
' NEED IF THEN to check if wbk being copied to is open, if yes continue copy and paste value, if no open then continue copy and paste
    Set wbk = Workbooks.Open(strSaveToFile)
    LastRowOutput = Sheets("LVL Total For Day Export").Range("A" & Rows.Count).End(xlUp).Row + 1
    Set outputRange = Sheets("LVL Total For Day Export").Range("A" & LastRowOutput)
    
    inputRange.Copy
    
    outputRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False

' End Save info from input file LVL Total For Day Export Temp sheet to Data file LVL Total For Day Export sheet
  
' Begin Save info from input file LVL Total For Day Export Temp sheet to Data file LVL Total For Day Export sheet
    LastRowInput = Sheets("LVL Shift Only Export Temp").Range("A" & Rows.Count).End(xlUp).Row
    
    Set inputRange = Sheets("LVL Shift Only Export Temp").Range("A2:AC" & LastRowInput)
    
    Set wbk = Workbooks.Open(strSaveToFile)
    LastRowOutput = Sheets("LVL Shift Only Export").Range("A" & Rows.Count).End(xlUp).Row + 1
    Set outputRange = Sheets("LVL Shift Only Export").Range("A" & LastRowOutput)
    
    inputRange.Copy
    
    outputRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False

' End Save info from input file LVL Total For Day Export Temp sheet to Data file LVL Total For Day Export sheet
    
    
    
' Save updated data file then close
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    
    
    'This hides the New Pay Period Input worksheet again after saving New Pay Period date
'    Sheets(S & "LVL Total For Day Export Temp").Visible = 2



End Sub

Open in new window

0
Comment
Question by:wlwebb
  • 6
  • 6
12 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35059461
Here is a sample code on how to check if a Workbook is open or not.

Sub Sample()
    Dim wBook As Workbook
    Dim strFile As String
    strFile = "C:\MyFile.xlsx"
    
    On Error Resume Next
    Set wBook = Workbooks(Dir(strFile))
    On Error GoTo 0
    
    If wBook Is Nothing Then
        MsgBox "not open"
    Else
        MsgBox " open"
    End If
End Sub

Open in new window


Sid
0
 

Author Comment

by:wlwebb
ID: 35059608
Sid thanks,

Since I will be copying a range from multiple sheets from wbk1 to multiple sheets on wbk2 is there a line of code to switch back and forth to which file is my "active" file.

Example
1st Copy and Paste
wbk1
Copy sheet1 a2:ac3

wbk2
Paste values sheet xyz a(last row)

2nd Copy and Paste
wbk1
Copy sheet7 a12:ac23

wbk2
Paste values sheet abc a(last row)

0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35059659
You don't need to switch between sheets or workbooks. You can do it in one line of code

For example if you want to copy from Sheet1 to Sheet2 then you can use this

Sheets("Sheet1").Range("A1").Copy Sheets("Sheet2").Range("A1")

If you want to copy from Sheet1 in workbook1 to Sheet2  in workbook2 then the above code becomes

Wb1.Sheets("Sheet1").Range("A1").Copy Wb2.Sheets("Sheet2").Range("A1")

Where Wb1 and Wb2 are the respective workbook objects.

Sid
0
 

Author Comment

by:wlwebb
ID: 35059681
Thanks I will give that a try. We  Newbies always try to make things harder than they are.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35059699
Let me know if you get stuck ;)

Sid
0
 

Author Comment

by:wlwebb
ID: 35059827
Errors out.  Note I am having the macro find the last input line before copy and pasting.

Here is the code where it errors out.

Stops on this line:
    LastRowInput = strCopyFromFile.Sheets("LVL Total For Day Export Temp").Range("A" & Rows.Count).End(xlUp).Row

Sub SaveDataInput()
    Dim wbk As Workbook
    Dim strCopyFromFile As String
    Dim strSaveToFile As String
    Dim inputRange As Range, outputRange As Range
    
    strCopyFromFile = "Clerk Shift Report.xlsm"
    strSaveToFile = "U:\DATA\Workpapers\Shift Details Data.xlsx"

' Test if save to workbook is open
 On Error Resume Next
 Set wbk = Workbooks(Dir(strSaveToFile))
 On Error GoTo 0
 
    If wbk Is Nothing Then
        Set wbk = Workbooks.Open(strSaveToFile)
        ' MsgBox "not open"
    Else
        ' MsgBox " Open"
    End If
' End Test if save to workbook is open

' Begin Save info 
    LastRowInput = strCopyFromFile.Sheets("LVL Total For Day Export Temp").Range("A" & Rows.Count).End(xlUp).Row
    
    Set inputRange = strCopyFromFile.Sheets("LVL Total For Day Export Temp").Range("A2:AC" & LastRowInput)

    LastRowOutput = strSaveToFile.Sheets("LVL Total For Day Export").Range("A" & Rows.Count).End(xlUp).Row + 1
    Set outputRange = strSaveToFile.Sheets("LVL Total For Day Export").Range("A" & LastRowOutput)
    
    inputRange.Copy
    
    outputRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False

' End Save Info

End Sub

Open in new window

0
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

 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35059845
Quick question. Are you running this code from Clerk Shift Report.xlsm?

Sid
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 500 total points
ID: 35059906
If yes, then is this what you are trying?

Sub SaveDataInput()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim strCopyFromFile As String, strSaveToFile As String
    Dim inputRange As Range, outputRange As Range
    Dim LastRowInput As Long
    
    strCopyFromFile = "Clerk Shift Report.xlsm"
    strSaveToFile = "U:\DATA\Workpapers\Shift Details Data.xlsx"
    
    Set wb1 = ActiveWorkbook
    Set ws1 = wb1.Sheets("LVL Total For Day Export Temp")
    
    '~~> Test if save to workbook is open
    On Error Resume Next
    Set wb2 = Workbooks(Dir(strSaveToFile))
    Set ws2 = wb2.Sheets("LVL Total For Day Export Temp")
    On Error GoTo 0
    
    If wb2 Is Nothing Then
        Set wb2 = Workbooks.Open(strSaveToFile)
        Set ws2 = wb2.Sheets("LVL Total For Day Export Temp")
    End If

    '~~> Begin Save info
    LastRowInput = ws1.Range("A" & Rows.Count).End(xlUp).Row
    LastRowOutput = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
    
    Set inputRange = ws1.Range("A2:AC" & LastRowInput)
    Set outputRange = ws2.Range("A" & LastRowOutput)
    
    inputRange.Copy
    
    outputRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
    Application.CutCopyMode = False
End Sub

Open in new window


Sid
0
 

Author Comment

by:wlwebb
ID: 35060404
Yes I am running it from Clerk Shift Report.xlsm
0
 

Author Comment

by:wlwebb
ID: 35060585
PERFECTION!!!  But, one follow on question which I referred to in my original question. { I am going to award half the points for the first part of the solution and then the other half for the follow on.

 It is regarding copying from multiple sheets and pasting to multiple sheets.

 Do I just repeat the whole "Begin Save Info" through the "Application.CutCopyMode=False"

OR

Do just add a "Set ws2, Set ws3 etc, Set ws4 to identify the other copy from sheets  and add Set statements for all the Copy to sheets?
0
 
LVL 30

Assisted Solution

by:SiddharthRout
SiddharthRout earned 500 total points
ID: 35060678
>>>Do just add a "Set ws2, Set ws3 etc, Set ws4 to identify the other copy from sheets  and add Set statements for all the Copy to sheets?

Yes. :)

Sid
0
 

Author Closing Comment

by:wlwebb
ID: 35061834
Sid is a master.  Thanks again for all your help
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
This article will show you how to use shortcut menus in the Access run-time environment.
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…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

743 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

13 Experts available now in Live!

Get 1:1 Help Now