View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default 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