My company will put up a new file daily on the shared folder and the filename
changes according to the date e.g. Shortage_080309.xls. I have to download it
everyday and work on it.

In this file, there are 3 worksheets. First worksheet has all the raw data,
it's the worksheet I need to work on. It's named "Shortage 080309", and the
name of the worksheet also changes according to current date. I don't use
the other 2 worksheets. They are named "Def" and "Sheet3" respectively.

What I am trying to do is to create a macro that can help me to,
1. insert a new worksheet in the same workbook
2. rename the new worksheet to "My Shortage <mmddyy>" eg. "My Shortage
080309",
3. copy all data from first/main worksheet "Shortage <mmddyy>" eg. "Shortage
080309" and paste it on the newly created worksheet.
4. on the new worksheet, filter the data on column D
5. sort by column D and that's it.

The data on column D (header is named "PRD") is 4 digit Prod number e.g.
0417,0604. Not all Prod numbers will appear in the file everyday. I have a
list of specific numbers (about 10 Prod number out of 1000+) that I want to
filter.

I can create the macro fairly easy in Excel 2007 to select the Prod number I
want, but the custom filter in Excel 2003 only allow me select 2 filter
requirements. I need 10.

Another thing is, the macro will be saved in the Excel file itself. How do
I make it "global", so that I am able to use it on another file?

All tips/advice/guidance are appreciated.

regards,
choo

try the code below. I didn't have time to test. Put the macro into a
workbook byitself. OPen the workbook every day and run the macro. the macro
uses two filedialog boxes to get the old and new workbook names.

The code extracts the date from the file name sor it automatically know the
old and new worksheet names. It performs the filtering by putting an X in
column IV for each row it needs to delete. The uses autofilter to get the
X's. See code below.

Modify filter to be the list of Numbers you want to keep.

Sub GetDailyfile()

'set filter to be Prod Numbers to Keep
FilterNumbers = Array(417, 604)

fileToCopy = Application _
.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Open Source File")
If fileToCopy = False Then
MsgBox ("Cannot get file - Exiting Sub")
Exit Sub
End If

fileSaveName = Application.GetSaveAsFilename( _
FileFilter:="Text Files (*.txt), *.txt", _
Title:="Get New filename")
If fileSaveName = False Then
MsgBox ("Cannot open file - Exiting Sub")
Exit Sub
End If

Set Fs = CreateObject("Scripting.FileSystemObject")
Fs.CopyFile fileToCopy, fileSaveName

DateStr = fileToCopy
'remove extension from filename
DateStr = Left(DateStr, InStrRev(DateStr, ".") - 1)
'get date from base filename
DateStr = Mid(DateStr, InStrRev(DateStr, "_") + 1)

Set bk = Workbooks.Open(Filename:=fileSaveName)

'copy shortage sheet to My shortage sheet
With bk
.Sheets("Shortage " & DateStr).Copy _
after:=.Sheets(.Sheets.Count)
Set Newsht = ActiveSheet
Newsht.Name = "My Shortage " & DateStr

'sort new sheet using column D
LastRow = .Range("D" & Rows.Count).End(xlUp).Row
Rows("1:" & LastRow).Sort _
header:=xlYes, _
key1:=.Range("D1"), _
order1:=xlAscending

RowCount = 2
Do While .Range("D" & Rows.Count) <> ""
ProdNumber = .Range("D" & Rows.Count)
'check if prodnumber should be filtered
Found = False
For Each num In FilterNumbers
If ProdNumber = num Then
Found = True
Exit For
End If
Next num

If Found = False Then
'put X in column IV for rows to be removed
Range("IV" & RowCount) = "X"
End If

RowCount = RowCount + 1
Loop

'filter on x's
.Columns("IV:IV").AutoFilter
.Columns("IV:IV").AutoFilter Field:=1, Criteria1:="X"

Set VisibleRows = Rows("2:" & LastRow) _
.SpecialCells(xlCellTypeVisible)
'delete rows with X's
VisibleRows.Delete
'turn off autfilter
.Columns("IV:IV").AutoFilter
End With


bk.Save
End Sub

There wrre some minor problems in mylast posting. The correct worksheet was
not being referenced properly.

Sub GetDailyfile()

'set filter to be Prod Numbers to Keep
FilterNumbers = Array(417, 604)

fileToCopy = Application _
.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Open Source File")
If fileToCopy = False Then
MsgBox ("Cannot get file - Exiting Sub")
Exit Sub
End If

fileSaveName = Application.GetSaveAsFilename( _
FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Get New filename")
If fileSaveName = False Then
MsgBox ("Cannot open file - Exiting Sub")
Exit Sub
End If

Set Fs = CreateObject("Scripting.FileSystemObject")
Fs.CopyFile fileToCopy, fileSaveName

DateStr = fileToCopy
'remove extension from filename
DateStr = Left(DateStr, InStrRev(DateStr, ".") - 1)
'get date from base filename
DateStr = Mid(DateStr, InStrRev(DateStr, "_") + 1)

Set bk = Workbooks.Open(Filename:=fileSaveName)

'copy shortage sheet to My shortage sheet
With bk
.Sheets("Shortage " & DateStr).Copy _
after:=.Sheets(.Sheets.Count)
Set NewSht = ActiveSheet
NewSht.Name = "My Shortage " & DateStr
End With

With NewSht
'sort new sheet using column D
LastRow = .Range("D" & Rows.Count).End(xlUp).Row
.Rows("1:" & LastRow).Sort _
header:=xlYes, _
key1:=.Range("D1"), _
order1:=xlAscending

RowCount = 2
Do While .Range("D" & Rows.Count) <> ""
ProdNumber = .Range("D" & Rows.Count)
'check if prodnumber should be filtered
Found = False
For Each num In FilterNumbers
If ProdNumber = num Then
Found = True
Exit For
End If
Next num

If Found = False Then
'put X in column IV for rows to be removed
.Range("IV" & RowCount) = "X"
End If

RowCount = RowCount + 1
Loop

'filter on x's
.Columns("IV:IV").AutoFilter
.Columns("IV:IV").AutoFilter Field:=1, Criteria1:="X"

Set VisibleRows = .Rows("2:" & LastRow) _
.SpecialCells(xlCellTypeVisible)
'delete rows with X's
VisibleRows.Delete
'turn off autfilter
.Columns("IV:IV").AutoFilter
End With


bk.Save
End Sub






"Joel" wrote:

> try the code below. I didn't have time to test. Put the macro into a
> workbook byitself. OPen the workbook every day and run the macro. the macro
> uses two filedialog boxes to get the old and new workbook names.
>
> The code extracts the date from the file name sor it automatically know the
> old and new worksheet names. It performs the filtering by putting an X in
> column IV for each row it needs to delete. The uses autofilter to get the
> X's. See code below.
>
> Modify filter to be the list of Numbers you want to keep.
>
> Sub GetDailyfile()
>
> 'set filter to be Prod Numbers to Keep
> FilterNumbers = Array(417, 604)
>
> fileToCopy = Application _
> .GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _
> Title:="Open Source File")
> If fileToCopy = False Then
> MsgBox ("Cannot get file - Exiting Sub")
> Exit Sub
> End If
>
> fileSaveName = Application.GetSaveAsFilename( _
> FileFilter:="Text Files (*.txt), *.txt", _
> Title:="Get New filename")
> If fileSaveName = False Then
> MsgBox ("Cannot open file - Exiting Sub")
> Exit Sub
> End If
>
> Set Fs = CreateObject("Scripting.FileSystemObject")
> Fs.CopyFile fileToCopy, fileSaveName
>
> DateStr = fileToCopy
> 'remove extension from filename
> DateStr = Left(DateStr, InStrRev(DateStr, ".") - 1)
> 'get date from base filename
> DateStr = Mid(DateStr, InStrRev(DateStr, "_") + 1)
>
> Set bk = Workbooks.Open(Filename:=fileSaveName)
>
> 'copy shortage sheet to My shortage sheet
> With bk
> .Sheets("Shortage " & DateStr).Copy _
> after:=.Sheets(.Sheets.Count)
> Set Newsht = ActiveSheet
> Newsht.Name = "My Shortage " & DateStr
>
> 'sort new sheet using column D
> LastRow = .Range("D" & Rows.Count).End(xlUp).Row
> Rows("1:" & LastRow).Sort _
> header:=xlYes, _
> key1:=.Range("D1"), _
> order1:=xlAscending
>
> RowCount = 2
> Do While .Range("D" & Rows.Count) <> ""
> ProdNumber = .Range("D" & Rows.Count)
> 'check if prodnumber should be filtered
> Found = False
> For Each num In FilterNumbers
> If ProdNumber = num Then
> Found = True
> Exit For
> End If
> Next num
>
> If Found = False Then
> 'put X in column IV for rows to be removed
> Range("IV" & RowCount) = "X"
> End If
>
> RowCount = RowCount + 1
> Loop
>
> 'filter on x's
> .Columns("IV:IV").AutoFilter
> .Columns("IV:IV").AutoFilter Field:=1, Criteria1:="X"
>
> Set VisibleRows = Rows("2:" & LastRow) _
> .SpecialCells(xlCellTypeVisible)
> 'delete rows with X's
> VisibleRows.Delete
> 'turn off autfilter
> .Columns("IV:IV").AutoFilter
> End With
>
>
> bk.Save
> End Sub
>

I will test it and let you know how it goes. Thanks for your help.

choo

"Joel" wrote:

> There wrre some minor problems in mylast posting. The correct worksheet was
> not being referenced properly.
>
> Sub GetDailyfile()
>
> 'set filter to be Prod Numbers to Keep
> FilterNumbers = Array(417, 604)
>
> fileToCopy = Application _
> .GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _
> Title:="Open Source File")
> If fileToCopy = False Then
> MsgBox ("Cannot get file - Exiting Sub")
> Exit Sub
> End If
>
> fileSaveName = Application.GetSaveAsFilename( _
> FileFilter:="Excel Files (*.xls), *.xls", _
> Title:="Get New filename")
> If fileSaveName = False Then
> MsgBox ("Cannot open file - Exiting Sub")
> Exit Sub
> End If
>
> Set Fs = CreateObject("Scripting.FileSystemObject")
> Fs.CopyFile fileToCopy, fileSaveName
>
> DateStr = fileToCopy
> 'remove extension from filename
> DateStr = Left(DateStr, InStrRev(DateStr, ".") - 1)
> 'get date from base filename
> DateStr = Mid(DateStr, InStrRev(DateStr, "_") + 1)
>
> Set bk = Workbooks.Open(Filename:=fileSaveName)
>
> 'copy shortage sheet to My shortage sheet
> With bk
> .Sheets("Shortage " & DateStr).Copy _
> after:=.Sheets(.Sheets.Count)
> Set NewSht = ActiveSheet
> NewSht.Name = "My Shortage " & DateStr
> End With
>
> With NewSht
> 'sort new sheet using column D
> LastRow = .Range("D" & Rows.Count).End(xlUp).Row
> .Rows("1:" & LastRow).Sort _
> header:=xlYes, _
> key1:=.Range("D1"), _
> order1:=xlAscending
>
> RowCount = 2
> Do While .Range("D" & Rows.Count) <> ""
> ProdNumber = .Range("D" & Rows.Count)
> 'check if prodnumber should be filtered
> Found = False
> For Each num In FilterNumbers
> If ProdNumber = num Then
> Found = True
> Exit For
> End If
> Next num
>
> If Found = False Then
> 'put X in column IV for rows to be removed
> .Range("IV" & RowCount) = "X"
> End If
>
> RowCount = RowCount + 1
> Loop
>
> 'filter on x's
> .Columns("IV:IV").AutoFilter
> .Columns("IV:IV").AutoFilter Field:=1, Criteria1:="X"
>
> Set VisibleRows = .Rows("2:" & LastRow) _
> .SpecialCells(xlCellTypeVisible)
> 'delete rows with X's
> VisibleRows.Delete
> 'turn off autfilter
> .Columns("IV:IV").AutoFilter
> End With
>
>
> bk.Save
> End Sub
>
>
>
>
>
>
> "Joel" wrote:
>
> > try the code below. I didn't have time to test. Put the macro into a
> > workbook byitself. OPen the workbook every day and run the macro. the macro
> > uses two filedialog boxes to get the old and new workbook names.
> >
> > The code extracts the date from the file name sor it automatically know the
> > old and new worksheet names. It performs the filtering by putting an X in
> > column IV for each row it needs to delete. The uses autofilter to get the
> > X's. See code below.
> >
> > Modify filter to be the list of Numbers you want to keep.
> >
> > Sub GetDailyfile()
> >
> > 'set filter to be Prod Numbers to Keep
> > FilterNumbers = Array(417, 604)
> >
> > fileToCopy = Application _
> > .GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _
> > Title:="Open Source File")
> > If fileToCopy = False Then
> > MsgBox ("Cannot get file - Exiting Sub")
> > Exit Sub
> > End If
> >
> > fileSaveName = Application.GetSaveAsFilename( _
> > FileFilter:="Text Files (*.txt), *.txt", _
> > Title:="Get New filename")
> > If fileSaveName = False Then
> > MsgBox ("Cannot open file - Exiting Sub")
> > Exit Sub
> > End If
> >
> > Set Fs = CreateObject("Scripting.FileSystemObject")
> > Fs.CopyFile fileToCopy, fileSaveName
> >
> > DateStr = fileToCopy
> > 'remove extension from filename
> > DateStr = Left(DateStr, InStrRev(DateStr, ".") - 1)
> > 'get date from base filename
> > DateStr = Mid(DateStr, InStrRev(DateStr, "_") + 1)
> >
> > Set bk = Workbooks.Open(Filename:=fileSaveName)
> >
> > 'copy shortage sheet to My shortage sheet
> > With bk
> > .Sheets("Shortage " & DateStr).Copy _
> > after:=.Sheets(.Sheets.Count)
> > Set Newsht = ActiveSheet
> > Newsht.Name = "My Shortage " & DateStr
> >
> > 'sort new sheet using column D
> > LastRow = .Range("D" & Rows.Count).End(xlUp).Row
> > Rows("1:" & LastRow).Sort _
> > header:=xlYes, _
> > key1:=.Range("D1"), _
> > order1:=xlAscending
> >
> > RowCount = 2
> > Do While .Range("D" & Rows.Count) <> ""
> > ProdNumber = .Range("D" & Rows.Count)
> > 'check if prodnumber should be filtered
> > Found = False
> > For Each num In FilterNumbers
> > If ProdNumber = num Then
> > Found = True
> > Exit For
> > End If
> > Next num
> >
> > If Found = False Then
> > 'put X in column IV for rows to be removed
> > Range("IV" & RowCount) = "X"
> > End If
> >
> > RowCount = RowCount + 1
> > Loop
> >
> > 'filter on x's
> > .Columns("IV:IV").AutoFilter
> > .Columns("IV:IV").AutoFilter Field:=1, Criteria1:="X"
> >
> > Set VisibleRows = Rows("2:" & LastRow) _
> > .SpecialCells(xlCellTypeVisible)
> > 'delete rows with X's
> > VisibleRows.Delete
> > 'turn off autfilter
> > .Columns("IV:IV").AutoFilter
> > End With
> >
> >
> > bk.Save
> > End Sub
> >

Hi Joel,
There is an error in this line, because it doesn't go into the Do loop at all.

Do While .Range("D" & Rows.Count) <> ""

It just jump straight out and onto the next block of code
NewSht.Coumns("IV:IV").AutoFilter

After that it shows error message "Run-time error 1004", command cannot
complete by using the range specified.

choo


"Joel" wrote:

> There wrre some minor problems in mylast posting. The correct worksheet was
> not being referenced properly.
>
> Sub GetDailyfile()
>
> 'set filter to be Prod Numbers to Keep
> FilterNumbers = Array(417, 604)
>
> fileToCopy = Application _
> .GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _
> Title:="Open Source File")
> If fileToCopy = False Then
> MsgBox ("Cannot get file - Exiting Sub")
> Exit Sub
> End If
>
> fileSaveName = Application.GetSaveAsFilename( _
> FileFilter:="Excel Files (*.xls), *.xls", _
> Title:="Get New filename")
> If fileSaveName = False Then
> MsgBox ("Cannot open file - Exiting Sub")
> Exit Sub
> End If
>
> Set Fs = CreateObject("Scripting.FileSystemObject")
> Fs.CopyFile fileToCopy, fileSaveName
>
> DateStr = fileToCopy
> 'remove extension from filename
> DateStr = Left(DateStr, InStrRev(DateStr, ".") - 1)
> 'get date from base filename
> DateStr = Mid(DateStr, InStrRev(DateStr, "_") + 1)
>
> Set bk = Workbooks.Open(Filename:=fileSaveName)
>
> 'copy shortage sheet to My shortage sheet
> With bk
> .Sheets("Shortage " & DateStr).Copy _
> after:=.Sheets(.Sheets.Count)
> Set NewSht = ActiveSheet
> NewSht.Name = "My Shortage " & DateStr
> End With
>
> With NewSht
> 'sort new sheet using column D
> LastRow = .Range("D" & Rows.Count).End(xlUp).Row
> .Rows("1:" & LastRow).Sort _
> header:=xlYes, _
> key1:=.Range("D1"), _
> order1:=xlAscending
>
> RowCount = 2
> Do While .Range("D" & Rows.Count) <> ""
> ProdNumber = .Range("D" & Rows.Count)
> 'check if prodnumber should be filtered
> Found = False
> For Each num In FilterNumbers
> If ProdNumber = num Then
> Found = True
> Exit For
> End If
> Next num
>
> If Found = False Then
> 'put X in column IV for rows to be removed
> .Range("IV" & RowCount) = "X"
> End If
>
> RowCount = RowCount + 1
> Loop
>
> 'filter on x's
> .Columns("IV:IV").AutoFilter
> .Columns("IV:IV").AutoFilter Field:=1, Criteria1:="X"
>
> Set VisibleRows = .Rows("2:" & LastRow) _
> .SpecialCells(xlCellTypeVisible)
> 'delete rows with X's
> VisibleRows.Delete
> 'turn off autfilter
> .Columns("IV:IV").AutoFilter
> End With
>
>
> bk.Save
> End Sub
>
>
>
>
>
>
> "Joel" wrote:
>
> > try the code below. I didn't have time to test. Put the macro into a
> > workbook byitself. OPen the workbook every day and run the macro. the macro
> > uses two filedialog boxes to get the old and new workbook names.
> >
> > The code extracts the date from the file name sor it automatically know the
> > old and new worksheet names. It performs the filtering by putting an X in
> > column IV for each row it needs to delete. The uses autofilter to get the
> > X's. See code below.
> >
> > Modify filter to be the list of Numbers you want to keep.
> >
> > Sub GetDailyfile()
> >
> > 'set filter to be Prod Numbers to Keep
> > FilterNumbers = Array(417, 604)
> >
> > fileToCopy = Application _
> > .GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _
> > Title:="Open Source File")
> > If fileToCopy = False Then
> > MsgBox ("Cannot get file - Exiting Sub")
> > Exit Sub
> > End If
> >
> > fileSaveName = Application.GetSaveAsFilename( _
> > FileFilter:="Text Files (*.txt), *.txt", _
> > Title:="Get New filename")
> > If fileSaveName = False Then
> > MsgBox ("Cannot open file - Exiting Sub")
> > Exit Sub
> > End If
> >
> > Set Fs = CreateObject("Scripting.FileSystemObject")
> > Fs.CopyFile fileToCopy, fileSaveName
> >
> > DateStr = fileToCopy
> > 'remove extension from filename
> > DateStr = Left(DateStr, InStrRev(DateStr, ".") - 1)
> > 'get date from base filename
> > DateStr = Mid(DateStr, InStrRev(DateStr, "_") + 1)
> >
> > Set bk = Workbooks.Open(Filename:=fileSaveName)
> >
> > 'copy shortage sheet to My shortage sheet
> > With bk
> > .Sheets("Shortage " & DateStr).Copy _
> > after:=.Sheets(.Sheets.Count)
> > Set Newsht = ActiveSheet
> > Newsht.Name = "My Shortage " & DateStr
> >
> > 'sort new sheet using column D
> > LastRow = .Range("D" & Rows.Count).End(xlUp).Row
> > Rows("1:" & LastRow).Sort _
> > header:=xlYes, _
> > key1:=.Range("D1"), _
> > order1:=xlAscending
> >
> > RowCount = 2
> > Do While .Range("D" & Rows.Count) <> ""
> > ProdNumber = .Range("D" & Rows.Count)
> > 'check if prodnumber should be filtered
> > Found = False
> > For Each num In FilterNumbers
> > If ProdNumber = num Then
> > Found = True
> > Exit For
> > End If
> > Next num
> >
> > If Found = False Then
> > 'put X in column IV for rows to be removed
> > Range("IV" & RowCount) = "X"
> > End If
> >
> > RowCount = RowCount + 1
> > Loop
> >
> > 'filter on x's
> > .Columns("IV:IV").AutoFilter
> > .Columns("IV:IV").AutoFilter Field:=1, Criteria1:="X"
> >
> > Set VisibleRows = Rows("2:" & LastRow) _
> > .SpecialCells(xlCellTypeVisible)
> > 'delete rows with X's
> > VisibleRows.Delete
> > 'turn off autfilter
> > .Columns("IV:IV").AutoFilter
> > End With
> >
> >
> > bk.Save
> > End Sub
> >