Announcement

Collapse
No announcement yet.

Filter by Date Range Copy and Paste to Sheet

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Filter by Date Range Copy and Paste to Sheet



    I would like to create a macro or VBA script that will work from a button to Filter records from sheet 2 based on a date range. Then copy the visible records and go to another sheet clear that sheet and paste the copied records. I have recorded this Macro to do it by choosing the dates under "Date Filter" "in Between" but I would like them to be able to enter the dates in to two cells and the filter use those values as the date range to filter with. I am triggering this from a button and entry cells on Sheet 1 "Entry" that triggers the filter of sheet 2 "QuickList_test" (based on date range) then pastes it to sheet 4 "Renewal_Report". THANKS IN ADVANCE!

    Code:
    Sub DateFilter()
    '
    ' DateFilter Macro
    '
    
    '
        Sheets("QuickList_test").Select
        ActiveCell.Cells.Select
        ActiveCell.Offset(0, 4).Range("A1").Activate
        Selection.AutoFilter
        Selection.AutoFilter
        Selection.AutoFilter
        ActiveWindow.ScrollColumn = 2
        ActiveWindow.ScrollColumn = 3
        ActiveSheet.Range("$A$1:$P$6999").AutoFilter Field:=12, Criteria1:= _
            ">=2/1/2012", Operator:=xlAnd, Criteria2:="<=2/28/2012"
        ActiveWindow.ScrollColumn = 2
        ActiveWindow.ScrollColumn = 1
        ActiveCell.Offset(0, -4).Range("A1:P7000").Select
        Selection.Copy
        Sheets("Renewal_Report").Select
        ActiveWindow.SmallScroll Down:=-15
        ActiveCell.Select
        ActiveSheet.Paste
        Selection.Columns.AutoFit
    End Sub

  • #2
    Re: Filter by Date Range Copy and Paste to Sheet

    see sample data in the file "joben.xls" attached.
    sheet 1 has data. sheet2 has result
    if your sheet names are different modify the macro suitably.
    the macro is in vb editor module1
    if you want you can create a button from "form" toolbar (view(menu)-toolbar-form) and assign this macro to that button

    note the criteria dates are in F1` and G1 in sheet 1
    if different modify suitably

    Code:
    Sub test()
    Dim r As Range, filt As Range, d1 As Long, d2 As Long
    With Worksheets("sheet1")
    d1 = .Range("F1").Value
    d2 = .Range("G1").Value
    .Range("A1").CurrentRegion.AutoFilter field:=.Range("A1").Column, Criteria1:=">=" & CDate(d1) _
        , Operator:=xlAnd, Criteria2:="<=" & CDate(d2)
    Set filt = .Range("a1").CurrentRegion.SpecialCells(xlCellTypeVisible)
    'filt.Copy
    With Worksheets("sheet2")
    .Cells.Clear
    filt.Copy
    .Range("a1").PasteSpecial
    .Range("A1:B1").EntireColumn.AutoFit
    End With
    .Range("A1").CurrentRegion.AutoFilter
    End With
    End Sub
    Attached Files
    I am not an expert. better solutions may be available. [email protected]$$$gmail.com

    Comment


    • #3


      Re: Filter by Date Range Copy and Paste to Sheet

      Thanks for the Help!
      I didn't mention that I was running this from an "Entry" Sheet so the data was not present there. But I added another with statement moved it above the references to the sheet with the data "QuickList_test" and it worked. Other changes were the column of reference for the data and I added a step so that it would take me to that sheet. Again Thanks!!

      Finished Product:
      Code:
      Sub DateFilter()
      '
      ' DateFilter Macro
      '
      
      Dim r As Range, filt As Range, d1 As Long, d2 As Long
      With Worksheets("Entry")
      d1 = .Range("F15").Value
      d2 = .Range("G15").Value
      With Worksheets("QuickList_test")
      .Range("A1").CurrentRegion.AutoFilter field:=.Range("L1").Column, Criteria1:=">=" & CDate(d1) _
          , Operator:=xlAnd, Criteria2:="<=" & CDate(d2)
      Set filt = .Range("L1").CurrentRegion.SpecialCells(xlCellTypeVisible)
      'filt.Copy
      With Worksheets("Renewal_Report")
      .Cells.Clear
      filt.Copy
      .Range("a1").PasteSpecial
      .Range("A1:Q1").EntireColumn.AutoFit
      End With
      .Range("L1").CurrentRegion.AutoFilter
      End With
      End With
      Worksheets("Renewal_Report").Activate
      
      End Sub

      Comment

      Working...
      X