Macros dealing with multiple workbooks

[Dan in Lowell]

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

 

[stanleydgromjr]

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]

Hi
paste the code onto Thisworkbook module
assuming both workbooks are in the same folder

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]

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

 

[stanleydgromjr]

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

 

[Dan in Lowell]

Sorry about that,

It is E:/Bosde01.........

Thanks

 

[stanleydgromjr]

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]

Hi,

This code actually errors on the "Set r =......." line when I run it.

Any suggestions?

 

[Dan in Lowell]

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]

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