Dear Experts,

I have two separate pieces of code create on two different Sub as per
below:


Code:
--------------------

Sub PromoTrack()

Dim Counter As Long
Dim Source As Workbook
Dim Destination As Workbook

Const MyDir As String = "c:\PromoTrack\MSA\"

Application.ScreenUpdating = False

For Counter = 7800 To 7809
Set Source = Workbooks.Open(MyDir & Counter & ".msa")
If Counter = 7800 Then
Source.Worksheets.Copy
Set Destination = ActiveWorkbook
ActiveSheet.Name = Counter
Else
Source.Worksheets.Copy After:=Destination.Worksheets(Destination.Workshee ts.Count)
Destination.Worksheets(Destination.Worksheets.Coun t).Name = Counter
End If
Source.Close False
Next

Destination.SaveAs MyDir & "Summary.xls"

Application.ScreenUpdating = True

MsgBox "Done"

End Sub

--------------------



Code:
--------------------

Sub ReadMSA()

Dim nCol, J, i As Integer

Workbooks.OpenText FileName:="C:\PromoTrack\MSA\7805.MSA"

nCol = 1

With ActiveSheet

For J = 1 To 80

If .Cells(J, nCol).Value = "lblProductCategory" Then
.Cells(J, nCol + 1).Select
.Cells(J, nCol + 1).Copy
Windows("PROMOPLANTRIAL.xls").Activate
Range("B1").Select
ActiveSheet.Paste
Windows("7805.MSA").Activate
End If

Etc… etc…

Next J

End With

End Sub

--------------------


Could you please let me know how to combine the two? I know there will
be changes in ReadMSA() as I am not using the same variables. Better
yet, can you help me re-write ReadMSA() so that it is fully integrated
in PromoTrack()?

I only want to copy the workbooks in PromoTrack() based on the content
of the cell (B2) read via ReadMSA()

Does this makes sense?

Many thanks :)

J


--
Petitboeuf
------------------------------------------------------------------------
Petitboeuf's Profile: http://www.excelforum.com/member.php...o&userid=10602
View this thread: http://www.excelforum.com/showthread...hreadid=535960

Hiya...

Any chance of getting some help regarding the above?

I just want to put a condition for copying each worksheet... I've done
the following but get an error 91 on the save line... :(


Code:
--------------------

Sub Blah()
Dim Counter As Long
Dim Source As Workbook
Dim Destination As Workbook
Dim R As Range


Const MyDir As String = "c:\PromoTrack\MSA\"

Application.ScreenUpdating = False

For Counter = 7800 To 7809
Set Source = Workbooks.Open(MyDir & Counter & ".msa")
Set R = Range("B2")

If R.Value = "Frozen and Chilled" Then

If Counter = 7800 Then
Source.Worksheets.Copy
Set Destination = ActiveWorkbook
ActiveSheet.Name = Counter
Else
Source.Worksheets.Copy After:=Destination.Worksheets(Destination.Workshee ts.Count)
Destination.Worksheets(Destination.Worksheets.Coun t).Name = Counter
End If

End If

Source.Close False

Next

Destination.SaveAs MyDir & "Summary.xls"

Application.ScreenUpdating = True

MsgBox "Frozen MSAs compiled"

End Sub

--------------------


Thanks again in advance!!


--
Petitboeuf
------------------------------------------------------------------------
Petitboeuf's Profile: http://www.excelforum.com/member.php...o&userid=10602
View this thread: http://www.excelforum.com/showthread...hreadid=535960

It looks as though you might not be creating the destination workbook...

Option Explicit
Sub Blah()
Dim Counter As Long
Dim Source As Workbook
Dim Destination As Workbook
Dim R As Range

Const MyDir As String = "c:\PromoTrack\MSA\"

Application.ScreenUpdating = False

For Counter = 7800 To 7809
Set Source = Workbooks.Open(MyDir & Counter & ".msa")
Set R = Range("B2")
If R.Value = "Frozen and Chilled" Then
If Counter = 7800 Then
Source.Worksheets.Copy
Set Destination = ActiveWorkbook
ActiveSheet.Name = Counter
Else
Source.Worksheets.Copy _
After:=Destination.Worksheets _
(Destination.Worksheets.Count)
Destination.Worksheets(Destination.Worksheets.Coun t).Name _
= Counter
End If
End If
Source.Close False
Next Counter

If Destination Is Nothing Then
MsgBox "Nothing was copied"
Else
Destination.SaveAs MyDir & "Summary.xls"
End If

Application.ScreenUpdating = True

MsgBox "Frozen MSAs compiled"

End Sub

If the first file (7800) doesn't have "frozen and chilled", then you could have
trouble.

But that may not be the current problem.

Petitboeuf wrote:

Hiya...

Any chance of getting some help regarding the above?

I just want to put a condition for copying each worksheet... I've done
the following but get an error 91 on the save line... :(

Code:
--------------------

Sub Blah()
Dim Counter As Long
Dim Source As Workbook
Dim Destination As Workbook
Dim R As Range


Const MyDir As String = "c:\PromoTrack\MSA\"

Application.ScreenUpdating = False

For Counter = 7800 To 7809
Set Source = Workbooks.Open(MyDir & Counter & ".msa")
Set R = Range("B2")

If R.Value = "Frozen and Chilled" Then

If Counter = 7800 Then
Source.Worksheets.Copy
Set Destination = ActiveWorkbook
ActiveSheet.Name = Counter
Else
Source.Worksheets.Copy After:=Destination.Worksheets(Destination.Workshee ts.Count)
Destination.Worksheets(Destination.Worksheets.Coun t).Name = Counter
End If

End If

Source.Close False

Next

Destination.SaveAs MyDir & "Summary.xls"

Application.ScreenUpdating = True

MsgBox "Frozen MSAs compiled"

End Sub

--------------------

Thanks again in advance!!

--
Petitboeuf
------------------------------------------------------------------------
Petitboeuf's Profile: http://www.excelforum.com/member.php...o&userid=10602
View this thread: http://www.excelforum.com/showthread...hreadid=535960

--

Dave Peterson

Dave

Thanks a lot for the reply.

7800 has indeed got Frozen and Chilled in cell B2... so it should
trigger the worksheet to be copied into Summary.xls...

I get both messages now LOL and no Summary.xls... :(


--
Petitboeuf
------------------------------------------------------------------------
Petitboeuf's Profile: http://www.excelforum.com/member.php...o&userid=10602
View this thread: http://www.excelforum.com/showthread...hreadid=535960

If you get that "Nothing was copied", then either 7800 doesn't have "frozen and
chilled" in it or you don't have a workbook that includes that number.

Maybe it'll be as simple as:

If lcase(R.Value) = lcase("Frozen and Chilled") Then

Or extra spaces or other typos????



Petitboeuf wrote:

Dave

Thanks a lot for the reply.

7800 has indeed got Frozen and Chilled in cell B2... so it should
trigger the worksheet to be copied into Summary.xls...

I get both messages now LOL and no Summary.xls... :(

--
Petitboeuf
------------------------------------------------------------------------
Petitboeuf's Profile: http://www.excelforum.com/member.php...o&userid=10602
View this thread: http://www.excelforum.com/showthread...hreadid=535960

--

Dave Peterson

... Destination = Nothing.

So why does it not create/keep the workbook as previously set?

Frozen and Chilled is in 5 of the 8 workbooks that I open, including
number 7800...


Very confused.....


--
Petitboeuf
------------------------------------------------------------------------
Petitboeuf's Profile: http://www.excelforum.com/member.php...o&userid=10602
View this thread: http://www.excelforum.com/showthread...hreadid=535960

You may think that you're creating that workbook, but I don't think you are (and
neither does excel!):

I bet if you added a message box:

....
If Counter = 7800 Then
MsgBox "Creating the new workbook!"
Source.Worksheets.Copy
Set Destination = ActiveWorkbook
ActiveSheet.Name = Counter
Else
....

You'd never see that msgbox.

An alternative is to create the workbook first and then just copy the sheets
into that new workbook.

First, I don't know what a .msa file is. Are you sure it's opening correctly?

This has a few msgboxes that may help you find the problem:

Option Explicit
Sub Blah()
Dim Counter As Long
Dim Source As Workbook
Dim Destination As Workbook
Dim R As Range

Const MyDir As String = "c:\PromoTrack\MSA\"

Application.ScreenUpdating = False

Set Destination = Workbooks.Add(1) 'single sheet
Destination.Worksheets(1).Name = "DeleteMeLater"

For Counter = 7800 To 7809
Set Source = Workbooks.Open(MyDir & Counter & ".msa")
Set R = Source.Worksheets(1).Range("B2")
If LCase(Trim(R.Value)) = LCase(Trim("Frozen and Chilled")) Then
'for testing only:
MsgBox "copying: " & Source.FullName

'copy just the first worksheet?
With Destination
Source.Worksheets(1).Copy _
After:=.Worksheets(.Worksheets.Count)
.Worksheets(.Worksheets.Count).Name = Counter
End With
Else
'just for testing
MsgBox "Not copying: " & Source.FullName
End If
Source.Close savechanges:=False
Next Counter

If Destination.Worksheets.Count = 1 Then
'only that dummy sheet is there
MsgBox "Nothing was copied"
Destination.Close savechanges:=False
Else
Application.DisplayAlerts = False
Destination.Worksheets("deletemelater").Delete
Application.DisplayAlerts = True
Destination.SaveAs MyDir & "Summary.xls"
MsgBox "Frozen MSAs compiled and saved as: " & Destination.FullName
End If

Application.ScreenUpdating = True

End Sub



Petitboeuf wrote:

.. Destination = Nothing.

So why does it not create/keep the workbook as previously set?

Frozen and Chilled is in 5 of the 8 workbooks that I open, including
number 7800...


Very confused.....

--
Petitboeuf
------------------------------------------------------------------------
Petitboeuf's Profile: http://www.excelforum.com/member.php...o&userid=10602
View this thread: http://www.excelforum.com/showthread...hreadid=535960

--

Dave Peterson