Friday, December 23, 2011

Apply sub filter in a range and paste the result in new workbook

If you want to apply filter on multiple columns and paste the result on a new workbook. Snapshot below-

Download Workbook

Here is the code-

Sub apply_sub_filter_on_different_fields()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wk As Worksheet
Dim wkb As Workbook
Set wk = ThisWorkbook.Sheets("Sample")
If wk.FilterMode Then
End If
i = wk.Range("a1").End(xlDown).Row
'apply filter
'apply filter on start date field first
' all date > 1 jan 2011
wk.Range("$A$1:$d$" & i).AutoFilter Field:=2, Criteria1:=">=" & Format(#1/1/2011#, "DD-MMM-yyyy")
'apply filter on end date field second
' all dates < 1 mar 2011
 wk.Range("$A$1:$d$" & i).AutoFilter Field:=3, Criteria1:="<=" & Format(#3/1/2011#, "DD-MMM-yyyy")
  'apply filter on name  field third
  wk.Range("$A$1:$d$" & i).AutoFilter Field:=1, Criteria1:="A"
Set Rng = wk.Range("$A$1:$d$" & i).SpecialCells(xlCellTypeVisible)
 ' new workbook is added
Set wkb = ActiveWorkbook
' filtered data is pasted on sheet1 of a new workbook
wkb.Sheets(1).Select ActiveSheet.Paste
ActiveSheet.Name = "Data"
' delete blank sheet 2 and 3
 If wk.FilterMode Then
End If
' save thw workbook and close it
'wkb.SaveAs "path and filename with extension "
 Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Download Workbook

No comments:

Post a Comment

Import data from SQL

Macro to import data from SQL using ADO connection string: Sub Import_data_from_SQL() ' Tools -> References -> Microsoft Active...