Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to detect changin filename & to hv more than 2 autofilter crit
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to detect changin filename & to hv more than 2 autofilter
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How can I detect change to Autofilter selection | Excel Programming | |||
Detect Autofilter Change Event | Excel Programming | |||
is there a formula to add numbers in a range based on several crit | Excel Discussion (Misc queries) | |||
Advancedfilter returning all rows instead of ones that match crit | Excel Programming | |||
How can I detect an AutoFilter when the Criteria isnt Met | Excel Programming |