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
 

Some videos you may like

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
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
 

Watch MrExcel Video

Forum statistics

Threads
1,113,918
Messages
5,545,025
Members
410,647
Latest member
bernardazar
Top