Macros dealing with multiple workbooks

Dan in Lowell

New Member
Joined
Sep 29, 2006
Messages
14
Hi,

I have a situation with which I hope someone can help.

I have two separate workbooks; "Change Orders" and "Issues Log". I would like to have a macro that:

1) Is run each time workbook "Issues Log" is opened
2) Reads down Column "B" on the first worksheet on the "Change Orders" workbook and when it finds a value of "Signed" will copy the corresponding row to the "summary" tab of the "Issues Log" workbook

The Change Order workbook is always kept in the same directory

Can anyone help?

Thanks in advance
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Joined
Jul 30, 2006
Messages
3,656
Questions?

What is the sheetname in 'Changed Orders'?
What is the cell address for the first data copy into the Summary sheet?
2) Reads down Column "B" on the first worksheet on the "Change Orders" workbook and when it finds a value of "Signed" will copy the corresponding row to the "summary" tab of the "Issues Log" workbook

What is the full path of the 'Changed Orders' workbook?
The Change Order workbook is always kept in the same directory


Have a great day,
Stan
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
Hi
paste the code onto Thisworkbook module
assuming both workbooks are in the same folder
Code:
Private Sub Workbook_Open()
Dim myPath As String, wsCopy As Worksheet, wsTo As Worksheet, r As Range
myPath = ThisWorkbook.Path & "\"
Set wsTo = ThisWorkbook.Sheets("Summary")
On Error Resume Next
Set wsCopy = Workbooks("Change Orders.xls").Sheets(1)
If wsCopy Is Nothing Then
   Set wsCopy = Workbooks.Open(myPath & "Change Orders.xls").Sheets(1)
End If
On Error GoTo 0
Set r = wsCopy.Columns("b").Find("Signed")
If Not r Is Nothing Then
   r.EntireRow.Copy wsTo.Range("a" & Rows.Count).End(xlUp).Offset(1)
Else
   MsgBox "Not found"
End If
'Workbooks("Change Orders.xls").Close False
Set wsCopy = Nothing : Set wsTo = Nothing
End Sub
 

Dan in Lowell

New Member
Joined
Sep 29, 2006
Messages
14
Stanley,

Thank you for your reply. The answers to your questions are as follows:

Questions?

What is the sheetname in 'Changed Orders'?
answer: BIN

What is the cell address for the first data copy into the Summary sheet?
Answer: A5

2) Reads down Column "B" on the first worksheet on the "Change Orders" workbook and when it finds a value of "Signed" will copy the corresponding row to the "summary" tab of the "Issues Log" workbook

What is the full path of the 'Changed Orders' workbook?
The Change Order workbook is always kept in the same directory
Answer: Bosdev01/apps/change Order Logs/change Order 8-23-06.xls

Thanks again for you help
 
Joined
Jul 30, 2006
Messages
3,656

ADVERTISEMENT

What is the full path including the drive mapping?

What is the full path of the 'Changed Orders' workbook?
The Change Order workbook is always kept in the same directory
Answer: Bosdev01/apps/change Order Logs/change Order 8-23-06.xls

? J:/Bosdev01/apps/change Order Logs/change Order 8-23-06.xls


Have a great day,
Stan
 
Joined
Jul 30, 2006
Messages
3,656

ADVERTISEMENT

Dan,

If both spreadsheets, "Change Orders" and "Issues Log", are in the same directory/folder, then the code above, from jindon, should work.

If not, let me know.


Have a great day,
Stan
 

Dan in Lowell

New Member
Joined
Sep 29, 2006
Messages
14
Hi,

I started over and am able to get the code above to work but unfortunatly it only copies the first row with matching "signed" criteria and then stops. I get no error saying that can't find something it just stops as though it is complete.
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
Code:
Private Sub Workbook_Open()
Dim myPath As String, wsCopy As Worksheet, wsTo As Worksheet, r As Range, ff As String
myPath = ThisWorkbook.Path & "\"
Set wsTo = ThisWorkbook.Sheets("Summary")
On Error Resume Next
Set wsCopy = Workbooks("Change Orders.xls").Sheets(1)
If wsCopy Is Nothing Then
   Set wsCopy = Workbooks.Open(myPath & "Change Orders.xls").Sheets(1)
End If
On Error GoTo 0
Set r = wsCopy.Columns("b").Find("Signed")
If Not r Is Nothing Then
   ff = r.Address
   Do
      r.EntireRow.Copy wsTo.Range("a" & Rows.Count).End(xlUp).Offset(1)
      Set r = ws.Copy.Columns("b").Find(Next(r)
   Loop Until ff = r.Address
Else
   MsgBox "Not found"
End If
'Workbooks("Change Orders.xls").Close False
Set wsCopy = Nothing : Set wsTo = Nothing
End Sub
 

Forum statistics

Threads
1,141,011
Messages
5,703,725
Members
421,311
Latest member
tanujath

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top