Combining two Subs

[Petitboeuf]

Dear Experts,

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

Please Login or Register  to view this content.

Please Login or Register  to view this content.

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]

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...

Please Login or Register  to view this content.

Thanks again in advance!!

[Dave Peterson]

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.Count).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.Worksheets.Count)
> Destination.Worksheets(Destination.Worksheets.Count).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

[Petitboeuf]

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...

[Dave Peterson]

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

[Petitboeuf]

... 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.....

[Dave Peterson]

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