How to detect changin filename & to hv more than 2 autofilter crit
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
|