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