[Petitboeuf]

Guys

You have been most helpful in making this code do what I want it to
do.

However there is still a major problem: it does not add tabs to the
spreadsheet...

I'll recap what the code is supposed to be doing:
1. Go through a directory on my C:\ and 'read' some .txt files (labeled
.msa)
2. Identify various labels within the document. If data = x then keep
tab and add a new one, if data = y then discard, etc.
3. Save the document.

Here is the code so far:

Code:
--------------------
Sub PromoTrack_Potatoes()

Dim Counter As Long
Dim Source As Workbook
Dim Destination As Workbook
Dim rDivision, rYear, rCategory, rOwner, rAccount As Range

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

Application.ScreenUpdating = False

For Counter = 1000 To 2000
Set Source = Workbooks.Open(MyDir & Counter & ".msa")
Set rDivision = Range("B2")
Set rYear = Range("B58")
Set rCategory = Range("B73")
Set rOwner = Range("B66")
Set rAccount = Range("B8")

If rDivision.Value = "Frozen and Chilled" Then
If rYear.Value = "2006" Then
If rCategory.Value = "Potatoes" Then
If rOwner.Value = "SOP" Then
If Counter = 1 Then
Source.Worksheets.Copy
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
End If
End If
End If

Source.Close False
Set Destination = ActiveWorkbook

Next

Destination.SaveAs MyDir & "Summary Potatoes.xls"

Application.ScreenUpdating = True

MsgBox "Frozen MSAs compiled"

End Sub
--------------------


Many thanks in advance for all the help you can provide!

Jules


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

[Dave Peterson]

Untested, but it did compile.

Option Explicit
Sub PromoTrack_Potatoes()

Dim Counter As Long
Dim Source As Workbook
Dim rDivision As Range
Dim rYear As Range
Dim rCategory As Range
Dim rOwner As Range
Dim rAccount As Range
Dim NewWkbk As Workbook

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

Application.ScreenUpdating = False

Set NewWkbk = Nothing

For Counter = 1000 To 2000
Set Source = Workbooks.Open(MyDir & Counter & ".msa")
With ActiveSheet
Set rDivision = .Range("B2")
Set rYear = .Range("B58")
Set rCategory = .Range("B73")
Set rOwner = .Range("B66")
Set rAccount = .Range("B8")
End With

If LCase(rDivision.Value) = LCase("Frozen and Chilled") Then
'is this just the year or
'do you need
'If Year(rYear.Value) = 2006 Then
'or even
'If rYear.Value = Year(Date) Then
'so you don't have to change this next year???
If rYear.Value = 2006 Then
If LCase(rCategory.Value) = LCase("Potatoes") Then
If LCase(rOwner.Value) = LCase("SOP") Then
If NewWkbk Is Nothing Then
'only one sheet in the source workbook
Source.Worksheets(1).Copy
Set NewWkbk = ActiveWorkbook
Else
Source.Worksheets(1).Copy _
after:=NewWkbk.Worksheets _
(NewWkbk.Worksheets.Count)
End If
ActiveSheet.Name = Counter
End If
End If
End If
End If

Source.Close savechanges:=False

Next Counter

NewWkbk.SaveAs MyDir & "Summary Potatoes.xls"

Application.ScreenUpdating = True

MsgBox "Frozen MSAs compiled"

End Sub

Some comments...

#1. Dim rDivision, rYear, rCategory, rOwner, rAccount As Range

Actually declares rAccount as a range, but the rest (rDivision, ...,
rOwner)
are declared as variants.

#2. If Counter = 1 Then
But counter loops from 1000 to 2000, so it's never equal to 1.

#3. I used a new variable called NewWkbk to represent the new workbook. I
check
to see if it's nothing. If it's nothing, then I use the workbook that
just got the new sheet copied into it.

If it's already set, then I just copy the next sheet into that workbook.

I'd stay away from a variable named "Destination". Excel/VBA may not
complain, but it confuses me.

rng.copy _
destination:=someothercell

#4. If rDivision.Value = "Frozen and Chilled" Then
If rYear.Value = "2006" Then

First, I made the string comparisons case-insensitive.
If lcase(rDivision.Value) = lcase("Frozen and Chilled") Then
Just in case there was a typo????

And does rYear actually just contain a year--not a date?
There are comments inline for that question.

And I just checked for a number, too (2006, not "2006").

Petitboeuf wrote:

Guys

You have been most helpful in making this code do what I want it to
do.

However there is still a major problem: it does not add tabs to the
spreadsheet...

I'll recap what the code is supposed to be doing:
1. Go through a directory on my C:\ and 'read' some .txt files (labeled
msa)
2. Identify various labels within the document. If data = x then keep
tab and add a new one, if data = y then discard, etc.
3. Save the document.

Here is the code so far:

Code:
--------------------
Sub PromoTrack_Potatoes()

Dim Counter As Long
Dim Source As Workbook
Dim Destination As Workbook
Dim rDivision, rYear, rCategory, rOwner, rAccount As Range

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

Application.ScreenUpdating = False

For Counter = 1000 To 2000
Set Source = Workbooks.Open(MyDir & Counter & ".msa")
Set rDivision = Range("B2")
Set rYear = Range("B58")
Set rCategory = Range("B73")
Set rOwner = Range("B66")
Set rAccount = Range("B8")

If rDivision.Value = "Frozen and Chilled" Then
If rYear.Value = "2006" Then
If rCategory.Value = "Potatoes" Then
If rOwner.Value = "SOP" Then
If Counter = 1 Then
Source.Worksheets.Copy
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
End If
End If
End If

Source.Close False
Set Destination = ActiveWorkbook

Next

Destination.SaveAs MyDir & "Summary Potatoes.xls"

Application.ScreenUpdating = True

MsgBox "Frozen MSAs compiled"

End Sub
--------------------

Many thanks in advance for all the help you can provide!

Jules

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

--

Dave Peterson