I have code (below) that opens and processes a separate raw data file,
segregates data into several different worksheets in that data file, then
saves the file.

I just found out that my code appears to corrupt the output files, which
then cannot be opened in Excel2003, but can be opened in Excel2007. I can
open *other* Excel files without a problem, but files created with this sub
are corrupt. I suspect that it has to do with how the file is saved, so I'm
posting just that snippet first, then the full code underneath. Should I be
more restrictive in the Filefilter parameter? Or do I need to forceably add
the ".xls" extension even though the save dialogue shows it to be saving as
an XLS file? The file does save with the xls extension, and looks like an XL
file in windows explorer (opens in Excel2003 when double clicked, but then
throws an 'unrecognizable format' error, and shows a worksheet filled with
ASCII characters).

Any advice or suggestions would be greatly appreciated.


Snippet:

DirectorySetPath ("\\wsak1\Perf\Score\Ops\Public\CurrentData")
new2fn = Application.GetSaveAsFilename( _
InitialFileName:="2010 USA Ops Salary Increases - " &
PasteMonthNum & " " & StrMonth, _
FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", _
Title:=TitleString)

ActiveWorkbook.SaveAs Filename:=new2fn



Full code:

Sub MakeReferenceWkbk()

'default start path, editable by user from the filepicker dialogue
PathOnly = "\\wsak1\Perf\Score\Ops\People\Increases"

Dim I As Integer
Dim owb As Workbook 'original/main
Dim twb As Workbook 'temp/data file
Dim ows As Worksheet
Dim tws As Worksheet

Set owb = ActiveWorkbook
Set ows = ActiveWorkbook.ActiveSheet

Dim SaveDriveDir As String
'save default path
SaveDriveDir = CurDir

TitleString = "Please select the Raw data file"

'change to new path
DirectorySetPath (PathOnly)

'get the file
newFN = Application.GetOpenFilename(FileFilter:="Excel-Compatible Files,
*.xls;*.xlsx;*.xlsm;*.csv", Title:=TitleString)
If newFN = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
'return to original default path
DirectorySetPath (SaveDriveDir)
Exit Sub
Else
MyFullFilePath = newFN
End If

Application.StatusBar = "Opening File " & MyFullFilePath

'Open source workbook
Application.DisplayAlerts = False
Set twb = Workbooks.Open(Filename:=MyFullFilePath, UpdateLinks:=0,
ReadOnly:=True)
Application.DisplayAlerts = True
twb.Activate
twb.Sheets(1).Activate

'update the file
For I = 1 To 6
ActiveWorkbook.Sheets.Add
Next

shtNameArr = Array("NWR", "NAR", "SWR", "SAR", "WWR")

For I = 1 To 5
ActiveWorkbook.Sheets(7).Select
ActiveWorkbook.Sheets(7).Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:=shtNameArr(I)
ActiveWorkbook.Sheets(7).Cells.Select
Selection.Copy
ActiveWorkbook.Sheets(I).Select
ActiveSheet.Paste
LRow = lastRow(Sheets(I))
ActiveSheet.Name = shtNameArr(I)
ActiveSheet.Cells.Select
ActiveSheet.Cells.EntireColumn.AutoFit
ActiveSheet.Range("V1").Select
Application.CutCopyMode = False
ActiveCell.Value = "Days Late"
ActiveSheet.Range("V2").Select
ActiveCell.Formula = "=IF(M2L2,M2-L2,"""")"
ActiveSheet.Range("V2").Select
Selection.AutoFill Destination:=Range("V2:V" & LRow)
ActiveSheet.Range("A1").Select
Next

ActiveWorkbook.Sheets(7).Select
ActiveWorkbook.Sheets(7).Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:="STTC"
Selection.AutoFilter Field:=18, Criteria1:="=03", Operator:=xlOr,
Criteria2:="=04"
ActiveWorkbook.Sheets(7).Cells.Select
Selection.Copy
ActiveWorkbook.Sheets(6).Select
ActiveSheet.Paste
LRow = lastRow(ActiveWorkbook.Sheets(6))
ActiveSheet.Name = "STTC"
ActiveSheet.Cells.Select
ActiveSheet.Cells.EntireColumn.AutoFit
ActiveSheet.Range("V1").Select
Application.CutCopyMode = False
ActiveCell.Value = "Days Late"
ActiveSheet.Range("V2").Select
ActiveCell.Formula = "=IF(M2L2,M2-L2,"""")"
ActiveSheet.Range("V2").Select
Selection.AutoFill Destination:=Range("V2:V" & LRow)
ActiveSheet.Range("A1").Select

ActiveWorkbook.Sheets(1).Activate
Application.DisplayAlerts = False
ActiveWorkbook.Sheets(7).Delete
Application.DisplayAlerts = True

'Select/copy a single cell to avoid clipboard warnings
ActiveSheet.Range("A1").Copy

''close the workbook to get it out of the way
'Application.DisplayAlerts = False 'just in case the clipboard trick doesn't
work
'twb.Close SaveChanges:=False
'Application.DisplayAlerts = True

Application.StatusBar = False

sDate = Year(Now()) & Format(Month(Now()), "00") & Format(Day(Now()), "00")
ShortFileName = ExtractFileName(MyFullFilePath)

'get the month "name" for the data set being saved, to put it in the filename
PasteMonths = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
PasteMonths2 = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug",
"Sep", "Oct", "Nov", "Dec")
PasteMonthNum = CInt(InputBox("Enter the month number represented by this
data (e.g. 1 for Jan, 2 for Feb, etc)", "Enter Data Month"))
If IsError(Application.Match(PasteMonthNum, PasteMonths, False)) Then
MsgBox "Unable to recognize a date from 1 to 12." & Chr(13) & Chr(13) &
"Output file not saved; please run again to finish processing", , "Month
Number Error"
Exit Sub
Else
StrMonth = PasteMonths2(PasteMonthNum)
End If

DirectorySetPath ("\\wsak1\Perf\Score\Ops\Public\CurrentData")
'GetSaveAsFilename
new2fn = Application.GetSaveAsFilename( _
InitialFileName:="2010 Ops Increases - " & PasteMonthNum & " " &
StrMonth, _
FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", _
Title:=TitleString)

ActiveWorkbook.SaveAs Filename:=new2fn

'return to original default path
DirectorySetPath (SaveDriveDir)

'PullAllRawData = Now()
MsgBox "Source data file has been successfully created and saved"

OldShortFN = ExtractFileName(newFN)
OldPathN = Left(newFN, Len(newFN) - Len(OldShortFN))
Debug.Print OldPathN & OldShortFN

Name newFN As OldPathN & OldShortFN

End Sub

Your code specifies a filename but not a file format when saving the
workbooks. Default format is xlsx, but if you use a different file
extension, Excel chokes when it tries opening the misnamed file.

Use this to save as Excel 97-2003 format:

ActiveWorkbook.SaveAs Filename:=new2fn, FileFormat:=xlExcel8

- Jon
-------
Jon Peltier
Peltier Technical Services, Inc.
http://peltiertech.com/


On 5/27/2010 6:04 PM, ker_01 wrote:
I have code (below) that opens and processes a separate raw data file,
segregates data into several different worksheets in that data file, then
saves the file.

I just found out that my code appears to corrupt the output files, which
then cannot be opened in Excel2003, but can be opened in Excel2007. I can
open *other* Excel files without a problem, but files created with this sub
are corrupt. I suspect that it has to do with how the file is saved, so I'm
posting just that snippet first, then the full code underneath. Should I be
more restrictive in the Filefilter parameter? Or do I need to forceably add
the ".xls" extension even though the save dialogue shows it to be saving as
an XLS file? The file does save with the xls extension, and looks like an XL
file in windows explorer (opens in Excel2003 when double clicked, but then
throws an 'unrecognizable format' error, and shows a worksheet filled with
ASCII characters).

Any advice or suggestions would be greatly appreciated.


Snippet:

DirectorySetPath ("\\wsak1\Perf\Score\Ops\Public\CurrentData")
new2fn = Application.GetSaveAsFilename( _
InitialFileName:="2010 USA Ops Salary Increases - "&
PasteMonthNum& " "& StrMonth, _
FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", _
Title:=TitleString)

ActiveWorkbook.SaveAs Filename:=new2fn



Full code:

Sub MakeReferenceWkbk()

'default start path, editable by user from the filepicker dialogue
PathOnly = "\\wsak1\Perf\Score\Ops\People\Increases"

Dim I As Integer
Dim owb As Workbook 'original/main
Dim twb As Workbook 'temp/data file
Dim ows As Worksheet
Dim tws As Worksheet

Set owb = ActiveWorkbook
Set ows = ActiveWorkbook.ActiveSheet

Dim SaveDriveDir As String
'save default path
SaveDriveDir = CurDir

TitleString = "Please select the Raw data file"

'change to new path
DirectorySetPath (PathOnly)

'get the file
newFN = Application.GetOpenFilename(FileFilter:="Excel-Compatible Files,
*.xls;*.xlsx;*.xlsm;*.csv", Title:=TitleString)
If newFN = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
'return to original default path
DirectorySetPath (SaveDriveDir)
Exit Sub
Else
MyFullFilePath = newFN
End If

Application.StatusBar = "Opening File "& MyFullFilePath

'Open source workbook
Application.DisplayAlerts = False
Set twb = Workbooks.Open(Filename:=MyFullFilePath, UpdateLinks:=0,
ReadOnly:=True)
Application.DisplayAlerts = True
twb.Activate
twb.Sheets(1).Activate

'update the file
For I = 1 To 6
ActiveWorkbook.Sheets.Add
Next

shtNameArr = Array("NWR", "NAR", "SWR", "SAR", "WWR")

For I = 1 To 5
ActiveWorkbook.Sheets(7).Select
ActiveWorkbook.Sheets(7).Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:=shtNameArr(I)
ActiveWorkbook.Sheets(7).Cells.Select
Selection.Copy
ActiveWorkbook.Sheets(I).Select
ActiveSheet.Paste
LRow = lastRow(Sheets(I))
ActiveSheet.Name = shtNameArr(I)
ActiveSheet.Cells.Select
ActiveSheet.Cells.EntireColumn.AutoFit
ActiveSheet.Range("V1").Select
Application.CutCopyMode = False
ActiveCell.Value = "Days Late"
ActiveSheet.Range("V2").Select
ActiveCell.Formula = "=IF(M2L2,M2-L2,"""")"
ActiveSheet.Range("V2").Select
Selection.AutoFill Destination:=Range("V2:V"& LRow)
ActiveSheet.Range("A1").Select
Next

ActiveWorkbook.Sheets(7).Select
ActiveWorkbook.Sheets(7).Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:="STTC"
Selection.AutoFilter Field:=18, Criteria1:="=03", Operator:=xlOr,
Criteria2:="=04"
ActiveWorkbook.Sheets(7).Cells.Select
Selection.Copy
ActiveWorkbook.Sheets(6).Select
ActiveSheet.Paste
LRow = lastRow(ActiveWorkbook.Sheets(6))
ActiveSheet.Name = "STTC"
ActiveSheet.Cells.Select
ActiveSheet.Cells.EntireColumn.AutoFit
ActiveSheet.Range("V1").Select
Application.CutCopyMode = False
ActiveCell.Value = "Days Late"
ActiveSheet.Range("V2").Select
ActiveCell.Formula = "=IF(M2L2,M2-L2,"""")"
ActiveSheet.Range("V2").Select
Selection.AutoFill Destination:=Range("V2:V"& LRow)
ActiveSheet.Range("A1").Select

ActiveWorkbook.Sheets(1).Activate
Application.DisplayAlerts = False
ActiveWorkbook.Sheets(7).Delete
Application.DisplayAlerts = True

'Select/copy a single cell to avoid clipboard warnings
ActiveSheet.Range("A1").Copy

''close the workbook to get it out of the way
'Application.DisplayAlerts = False 'just in case the clipboard trick doesn't
work
'twb.Close SaveChanges:=False
'Application.DisplayAlerts = True

Application.StatusBar = False

sDate = Year(Now())& Format(Month(Now()), "00")& Format(Day(Now()), "00")
ShortFileName = ExtractFileName(MyFullFilePath)

'get the month "name" for the data set being saved, to put it in the filename
PasteMonths = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
PasteMonths2 = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug",
"Sep", "Oct", "Nov", "Dec")
PasteMonthNum = CInt(InputBox("Enter the month number represented by this
data (e.g. 1 for Jan, 2 for Feb, etc)", "Enter Data Month"))
If IsError(Application.Match(PasteMonthNum, PasteMonths, False)) Then
MsgBox "Unable to recognize a date from 1 to 12."& Chr(13)& Chr(13)&
"Output file not saved; please run again to finish processing", , "Month
Number Error"
Exit Sub
Else
StrMonth = PasteMonths2(PasteMonthNum)
End If

DirectorySetPath ("\\wsak1\Perf\Score\Ops\Public\CurrentData")
'GetSaveAsFilename
new2fn = Application.GetSaveAsFilename( _
InitialFileName:="2010 Ops Increases - "& PasteMonthNum& " "&
StrMonth, _
FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", _
Title:=TitleString)

ActiveWorkbook.SaveAs Filename:=new2fn

'return to original default path
DirectorySetPath (SaveDriveDir)

'PullAllRawData = Now()
MsgBox "Source data file has been successfully created and saved"

OldShortFN = ExtractFileName(newFN)
OldPathN = Left(newFN, Len(newFN) - Len(OldShortFN))
Debug.Print OldPathN& OldShortFN

Name newFN As OldPathN& OldShortFN

End Sub

Awesome, thank you Jon!

"Jon Peltier" wrote:

Your code specifies a filename but not a file format when saving the
workbooks. Default format is xlsx, but if you use a different file
extension, Excel chokes when it tries opening the misnamed file.

Use this to save as Excel 97-2003 format:

ActiveWorkbook.SaveAs Filename:=new2fn, FileFormat:=xlExcel8

- Jon
-------
Jon Peltier
Peltier Technical Services, Inc.
http://peltiertech.com/


On 5/27/2010 6:04 PM, ker_01 wrote:
I have code (below) that opens and processes a separate raw data file,
segregates data into several different worksheets in that data file, then
saves the file.

I just found out that my code appears to corrupt the output files, which
then cannot be opened in Excel2003, but can be opened in Excel2007. I can
open *other* Excel files without a problem, but files created with this sub
are corrupt. I suspect that it has to do with how the file is saved, so I'm
posting just that snippet first, then the full code underneath. Should I be
more restrictive in the Filefilter parameter? Or do I need to forceably add
the ".xls" extension even though the save dialogue shows it to be saving as
an XLS file? The file does save with the xls extension, and looks like an XL
file in windows explorer (opens in Excel2003 when double clicked, but then
throws an 'unrecognizable format' error, and shows a worksheet filled with
ASCII characters).

Any advice or suggestions would be greatly appreciated.


Snippet:

DirectorySetPath ("\\wsak1\Perf\Score\Ops\Public\CurrentData")
new2fn = Application.GetSaveAsFilename( _
InitialFileName:="2010 USA Ops Salary Increases - "&
PasteMonthNum& " "& StrMonth, _
FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", _
Title:=TitleString)

ActiveWorkbook.SaveAs Filename:=new2fn



Full code:

Sub MakeReferenceWkbk()

'default start path, editable by user from the filepicker dialogue
PathOnly = "\\wsak1\Perf\Score\Ops\People\Increases"

Dim I As Integer
Dim owb As Workbook 'original/main
Dim twb As Workbook 'temp/data file
Dim ows As Worksheet
Dim tws As Worksheet

Set owb = ActiveWorkbook
Set ows = ActiveWorkbook.ActiveSheet

Dim SaveDriveDir As String
'save default path
SaveDriveDir = CurDir

TitleString = "Please select the Raw data file"

'change to new path
DirectorySetPath (PathOnly)

'get the file
newFN = Application.GetOpenFilename(FileFilter:="Excel-Compatible Files,
*.xls;*.xlsx;*.xlsm;*.csv", Title:=TitleString)
If newFN = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
'return to original default path
DirectorySetPath (SaveDriveDir)
Exit Sub
Else
MyFullFilePath = newFN
End If

Application.StatusBar = "Opening File "& MyFullFilePath

'Open source workbook
Application.DisplayAlerts = False
Set twb = Workbooks.Open(Filename:=MyFullFilePath, UpdateLinks:=0,
ReadOnly:=True)
Application.DisplayAlerts = True
twb.Activate
twb.Sheets(1).Activate

'update the file
For I = 1 To 6
ActiveWorkbook.Sheets.Add
Next

shtNameArr = Array("NWR", "NAR", "SWR", "SAR", "WWR")

For I = 1 To 5
ActiveWorkbook.Sheets(7).Select
ActiveWorkbook.Sheets(7).Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:=shtNameArr(I)
ActiveWorkbook.Sheets(7).Cells.Select
Selection.Copy
ActiveWorkbook.Sheets(I).Select
ActiveSheet.Paste
LRow = lastRow(Sheets(I))
ActiveSheet.Name = shtNameArr(I)
ActiveSheet.Cells.Select
ActiveSheet.Cells.EntireColumn.AutoFit
ActiveSheet.Range("V1").Select
Application.CutCopyMode = False
ActiveCell.Value = "Days Late"
ActiveSheet.Range("V2").Select
ActiveCell.Formula = "=IF(M2L2,M2-L2,"""")"
ActiveSheet.Range("V2").Select
Selection.AutoFill Destination:=Range("V2:V"& LRow)
ActiveSheet.Range("A1").Select
Next

ActiveWorkbook.Sheets(7).Select
ActiveWorkbook.Sheets(7).Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:="STTC"
Selection.AutoFilter Field:=18, Criteria1:="=03", Operator:=xlOr,
Criteria2:="=04"
ActiveWorkbook.Sheets(7).Cells.Select
Selection.Copy
ActiveWorkbook.Sheets(6).Select
ActiveSheet.Paste
LRow = lastRow(ActiveWorkbook.Sheets(6))
ActiveSheet.Name = "STTC"
ActiveSheet.Cells.Select
ActiveSheet.Cells.EntireColumn.AutoFit
ActiveSheet.Range("V1").Select
Application.CutCopyMode = False
ActiveCell.Value = "Days Late"
ActiveSheet.Range("V2").Select
ActiveCell.Formula = "=IF(M2L2,M2-L2,"""")"
ActiveSheet.Range("V2").Select
Selection.AutoFill Destination:=Range("V2:V"& LRow)
ActiveSheet.Range("A1").Select

ActiveWorkbook.Sheets(1).Activate
Application.DisplayAlerts = False
ActiveWorkbook.Sheets(7).Delete
Application.DisplayAlerts = True

'Select/copy a single cell to avoid clipboard warnings
ActiveSheet.Range("A1").Copy

''close the workbook to get it out of the way
'Application.DisplayAlerts = False 'just in case the clipboard trick doesn't
work
'twb.Close SaveChanges:=False
'Application.DisplayAlerts = True

Application.StatusBar = False

sDate = Year(Now())& Format(Month(Now()), "00")& Format(Day(Now()), "00")
ShortFileName = ExtractFileName(MyFullFilePath)

'get the month "name" for the data set being saved, to put it in the filename
PasteMonths = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
PasteMonths2 = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug",
"Sep", "Oct", "Nov", "Dec")
PasteMonthNum = CInt(InputBox("Enter the month number represented by this
data (e.g. 1 for Jan, 2 for Feb, etc)", "Enter Data Month"))
If IsError(Application.Match(PasteMonthNum, PasteMonths, False)) Then
MsgBox "Unable to recognize a date from 1 to 12."& Chr(13)& Chr(13)&
"Output file not saved; please run again to finish processing", , "Month
Number Error"
Exit Sub
Else
StrMonth = PasteMonths2(PasteMonthNum)
End If

DirectorySetPath ("\\wsak1\Perf\Score\Ops\Public\CurrentData")
'GetSaveAsFilename
new2fn = Application.GetSaveAsFilename( _
InitialFileName:="2010 Ops Increases - "& PasteMonthNum& " "&
StrMonth, _
FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", _
Title:=TitleString)

ActiveWorkbook.SaveAs Filename:=new2fn

'return to original default path
DirectorySetPath (SaveDriveDir)

'PullAllRawData = Now()
MsgBox "Source data file has been successfully created and saved"

OldShortFN = ExtractFileName(newFN)
OldPathN = Left(newFN, Len(newFN) - Len(OldShortFN))
Debug.Print OldPathN& OldShortFN

Name newFN As OldPathN& OldShortFN

End Sub
.

Can you tell that one tripped me up, costing several hours of unbillable
work?

- Jon
-------
Jon Peltier
Peltier Technical Services, Inc.
http://peltiertech.com/


On 6/1/2010 11:30 AM, ker_01 wrote:
Awesome, thank you Jon!

"Jon Peltier" wrote:

Your code specifies a filename but not a file format when saving the
workbooks. Default format is xlsx, but if you use a different file
extension, Excel chokes when it tries opening the misnamed file.

Use this to save as Excel 97-2003 format:

ActiveWorkbook.SaveAs Filename:=new2fn, FileFormat:=xlExcel8

- Jon
-------
Jon Peltier
Peltier Technical Services, Inc.
http://peltiertech.com/


On 5/27/2010 6:04 PM, ker_01 wrote:
I have code (below) that opens and processes a separate raw data file,
segregates data into several different worksheets in that data file, then
saves the file.

I just found out that my code appears to corrupt the output files, which
then cannot be opened in Excel2003, but can be opened in Excel2007. I can
open *other* Excel files without a problem, but files created with this sub
are corrupt. I suspect that it has to do with how the file is saved, so I'm
posting just that snippet first, then the full code underneath. Should I be
more restrictive in the Filefilter parameter? Or do I need to forceably add
the ".xls" extension even though the save dialogue shows it to be saving as
an XLS file? The file does save with the xls extension, and looks like an XL
file in windows explorer (opens in Excel2003 when double clicked, but then
throws an 'unrecognizable format' error, and shows a worksheet filled with
ASCII characters).

Any advice or suggestions would be greatly appreciated.


Snippet:

DirectorySetPath ("\\wsak1\Perf\Score\Ops\Public\CurrentData")
new2fn = Application.GetSaveAsFilename( _
InitialFileName:="2010 USA Ops Salary Increases - "&
PasteMonthNum& ""& StrMonth, _
FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", _
Title:=TitleString)

ActiveWorkbook.SaveAs Filename:=new2fn



Full code:

Sub MakeReferenceWkbk()

'default start path, editable by user from the filepicker dialogue
PathOnly = "\\wsak1\Perf\Score\Ops\People\Increases"

Dim I As Integer
Dim owb As Workbook 'original/main
Dim twb As Workbook 'temp/data file
Dim ows As Worksheet
Dim tws As Worksheet

Set owb = ActiveWorkbook
Set ows = ActiveWorkbook.ActiveSheet

Dim SaveDriveDir As String
'save default path
SaveDriveDir = CurDir

TitleString = "Please select the Raw data file"

'change to new path
DirectorySetPath (PathOnly)

'get the file
newFN = Application.GetOpenFilename(FileFilter:="Excel-Compatible Files,
*.xls;*.xlsx;*.xlsm;*.csv", Title:=TitleString)
If newFN = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
'return to original default path
DirectorySetPath (SaveDriveDir)
Exit Sub
Else
MyFullFilePath = newFN
End If

Application.StatusBar = "Opening File "& MyFullFilePath

'Open source workbook
Application.DisplayAlerts = False
Set twb = Workbooks.Open(Filename:=MyFullFilePath, UpdateLinks:=0,
ReadOnly:=True)
Application.DisplayAlerts = True
twb.Activate
twb.Sheets(1).Activate

'update the file
For I = 1 To 6
ActiveWorkbook.Sheets.Add
Next

shtNameArr = Array("NWR", "NAR", "SWR", "SAR", "WWR")

For I = 1 To 5
ActiveWorkbook.Sheets(7).Select
ActiveWorkbook.Sheets(7).Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:=shtNameArr(I)
ActiveWorkbook.Sheets(7).Cells.Select
Selection.Copy
ActiveWorkbook.Sheets(I).Select
ActiveSheet.Paste
LRow = lastRow(Sheets(I))
ActiveSheet.Name = shtNameArr(I)
ActiveSheet.Cells.Select
ActiveSheet.Cells.EntireColumn.AutoFit
ActiveSheet.Range("V1").Select
Application.CutCopyMode = False
ActiveCell.Value = "Days Late"
ActiveSheet.Range("V2").Select
ActiveCell.Formula = "=IF(M2L2,M2-L2,"""")"
ActiveSheet.Range("V2").Select
Selection.AutoFill Destination:=Range("V2:V"& LRow)
ActiveSheet.Range("A1").Select
Next

ActiveWorkbook.Sheets(7).Select
ActiveWorkbook.Sheets(7).Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=9, Criteria1:="STTC"
Selection.AutoFilter Field:=18, Criteria1:="=03", Operator:=xlOr,
Criteria2:="=04"
ActiveWorkbook.Sheets(7).Cells.Select
Selection.Copy
ActiveWorkbook.Sheets(6).Select
ActiveSheet.Paste
LRow = lastRow(ActiveWorkbook.Sheets(6))
ActiveSheet.Name = "STTC"
ActiveSheet.Cells.Select
ActiveSheet.Cells.EntireColumn.AutoFit
ActiveSheet.Range("V1").Select
Application.CutCopyMode = False
ActiveCell.Value = "Days Late"
ActiveSheet.Range("V2").Select
ActiveCell.Formula = "=IF(M2L2,M2-L2,"""")"
ActiveSheet.Range("V2").Select
Selection.AutoFill Destination:=Range("V2:V"& LRow)
ActiveSheet.Range("A1").Select

ActiveWorkbook.Sheets(1).Activate
Application.DisplayAlerts = False
ActiveWorkbook.Sheets(7).Delete
Application.DisplayAlerts = True

'Select/copy a single cell to avoid clipboard warnings
ActiveSheet.Range("A1").Copy

''close the workbook to get it out of the way
'Application.DisplayAlerts = False 'just in case the clipboard trick doesn't
work
'twb.Close SaveChanges:=False
'Application.DisplayAlerts = True

Application.StatusBar = False

sDate = Year(Now())& Format(Month(Now()), "00")& Format(Day(Now()), "00")
ShortFileName = ExtractFileName(MyFullFilePath)

'get the month "name" for the data set being saved, to put it in the filename
PasteMonths = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
PasteMonths2 = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug",
"Sep", "Oct", "Nov", "Dec")
PasteMonthNum = CInt(InputBox("Enter the month number represented by this
data (e.g. 1 for Jan, 2 for Feb, etc)", "Enter Data Month"))
If IsError(Application.Match(PasteMonthNum, PasteMonths, False)) Then
MsgBox "Unable to recognize a date from 1 to 12."& Chr(13)& Chr(13)&
"Output file not saved; please run again to finish processing", , "Month
Number Error"
Exit Sub
Else
StrMonth = PasteMonths2(PasteMonthNum)
End If

DirectorySetPath ("\\wsak1\Perf\Score\Ops\Public\CurrentData")
'GetSaveAsFilename
new2fn = Application.GetSaveAsFilename( _
InitialFileName:="2010 Ops Increases - "& PasteMonthNum& ""&
StrMonth, _
FileFilter:="Excel-Compatible Files, *.xls;*.xlsx;*.xlsm;*.csv", _
Title:=TitleString)

ActiveWorkbook.SaveAs Filename:=new2fn

'return to original default path
DirectorySetPath (SaveDriveDir)

'PullAllRawData = Now()
MsgBox "Source data file has been successfully created and saved"

OldShortFN = ExtractFileName(newFN)
OldPathN = Left(newFN, Len(newFN) - Len(OldShortFN))
Debug.Print OldPathN& OldShortFN

Name newFN As OldPathN& OldShortFN

End Sub
.