Results 1 to 17 of 17

Advanced Filter "<=Date" does not work?

Threaded View

  1. #1
    Registered User
    Join Date
    03-30-2011
    Location
    Swansea
    MS-Off Ver
    Excel 2007
    Posts
    72

    Advanced Filter "<=Date" does not work?

    I just can not get this code to work.

    I want it to look for data equal to a user inputted Account Number and Start and End Date. The input bit seems to work, the rest doesn't.

    
    Public Sub Demo()
    Dim ResultRowCount As Long
    
    ' config here
    Const AccountColumn As Integer = 1
    Const DateColumn As Integer = 2
    Const DirectoryToSaveIn As String = "C:\Test\"
    
    
    tryAgain:
    StartDate = Application.InputBox("Start Date i.e. 01/01/2011", "StartDate ")
    If StartDate = False Then Exit Sub
    
    'Validation of date format
    If Not StartDate Like "##/##/####" Then
    msg = "Entry must be dd/mm/yyyy format"
    pt = MsgBox(msg, vbExclamation, "Invalid entry")
    GoTo tryAgain
    End If
    If Not IsDate(StartDate) Then
    msg = "Entry must be dd/mm/yyyy format"
    pt = MsgBox(msg, vbExclamation, "Invalid entry")
    GoTo tryAgain
    End If
    
    
    tryAgain1:
    EndDate = Application.InputBox("End Date i.e. 31/01/2011", "End Date")
    If EndDate = False Then Exit Sub
    'Validation of date format
    If Not EndDate Like "##/##/####" Then
    msg = "Entry must be dd/mm/yyyy format"
    pt = MsgBox(msg, vbExclamation, "Invalid entry")
    GoTo tryAgain1
    End If
    If Not IsDate(EndDate) Then
    msg = "Entry must be dd/mm/yyyy format"
    pt = MsgBox(msg, vbExclamation, "Invalid entry")
    GoTo tryAgain1
    End If
    
    
    AccountNumber = Application.InputBox("Account Number", "Account Number")
    If AccountNumber = False Then Exit Sub
    
    
    ' Copy sheet
    ActiveSheet.Copy
    
    ' Set up Criteria for advanced filter
    Range("X1").Value = Cells(1, Account).Value
    Range("Y1").Value = Cells(1, Date).Value
    Range("Z1").Value = Cells(1, Date).Value
    Range("X2").Value = AccountNumber
    Range("Y2").Value = ">=" & StartDate
    Range("Z2").Value = "<=" & EndDate
    
    ' Apply Advanced Filter
    Columns("A:W").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
    "X1:Z2"), CopyToRange:=Range("AA1:AI1"), Unique:=False
    
    
    ' Get Rid of old data
    Columns("A:Z").Delete
    
    ResultRowCount = Cells.Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    
    ' Save File New Name
    Filename = AccountNumber & "_" & Format(StartDate, "mmm_yy") & ".xls"
    ActiveWorkbook.SaveAs Filename:=DirectoryToSaveIn & Filename
    ActiveWorkbook.Close
    
    'Inform user of results
    ln1 = "Location : " & DirectoryToSaveIn & vbNewLine
    ln2 = "FileName : " & Filename & vbNewLine
    ln3 = "Row Count: " & ResultRowCount & vbNewLine
    msg = ln1 & ln2 & ln3
    pt = MsgBox(msg, vbInformation, "Process Complete")
    Attached Files Attached Files
    Last edited by MAButler; 04-04-2011 at 02:41 PM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1