Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 25
Default 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   Report Post  
Posted to microsoft.public.excel.programming
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

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How can I detect change to Autofilter selection MikeZz Excel Programming 1 July 23rd 09 06:23 AM
Detect Autofilter Change Event Alan Z. Scharf Excel Programming 2 March 13th 09 10:01 PM
is there a formula to add numbers in a range based on several crit BROCK8292 Excel Discussion (Misc queries) 2 March 25th 08 01:00 AM
Advancedfilter returning all rows instead of ones that match crit jjfjr Excel Programming 8 July 13th 05 08:37 PM
How can I detect an AutoFilter when the Criteria isnt Met Frederick Excel Programming 2 August 12th 03 02:43 PM


All times are GMT +1. The time now is 12:23 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"