A
Albert
Hi Guys,
I have been using the following code (courtesy of Ron debruin):
Sub Copy_With_AutoFilter1()
Dim ws As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim DestSh As Worksheet
Dim Lr As Long
Dim sourceWB As Workbook
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If bIsBookOpen("Test DB.xlsm") Then
Set destWB = Workbooks("Test DB.xlsm")
Else
Set destWB = Workbooks.Open("K:\Customer services screen\Test
Database\Test DB.xlsm")
End If
Set ws = destWB.Sheets("Sheet1")
Set rng = ws.Range("A1:ab" & Rows.Count)
FieldNum = 1
ws.AutoFilterMode = False
On Error Resume Next
Application.DisplayAlerts = False
Sheets("MyFilterResult").Delete
Application.DisplayAlerts = True
On Error GoTo 0
rng.AutoFilter Field:=3, Criteria1:="=" & ComboBoxCustomerAgent.Value
rng.AutoFilter Field:=14, Criteria1:="=" & DTPicker1.Value
rng.AutoFilter Field:=18, Criteria1:="= Open"
Set WSNew = Workbooks("Customer services test.xlsm").Worksheets("Sheet2")
ws.AutoFilter.Range.Copy
With WSNew.Range("A1")
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
'
Application.CutCopyMode = False
TextBoxWorkfortoday.Text = Cells(Rows.Count, 1).End(xlUp).Row - 1
End With
'
With ws.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then rng2.EntireRow.Delete
End With
ws.AutoFilterMode = False
destWB.Close SaveChanges:=True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Workbooks("Customer services test.xlsm").Worksheets("Sheet1").Activate
End Sub
I have 2 questions:
The autofilter is not filtering on all criteria?
And then not deleting those records that were filtered?
Any help?
Thanks
Albert
I have been using the following code (courtesy of Ron debruin):
Sub Copy_With_AutoFilter1()
Dim ws As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim DestSh As Worksheet
Dim Lr As Long
Dim sourceWB As Workbook
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If bIsBookOpen("Test DB.xlsm") Then
Set destWB = Workbooks("Test DB.xlsm")
Else
Set destWB = Workbooks.Open("K:\Customer services screen\Test
Database\Test DB.xlsm")
End If
Set ws = destWB.Sheets("Sheet1")
Set rng = ws.Range("A1:ab" & Rows.Count)
FieldNum = 1
ws.AutoFilterMode = False
On Error Resume Next
Application.DisplayAlerts = False
Sheets("MyFilterResult").Delete
Application.DisplayAlerts = True
On Error GoTo 0
rng.AutoFilter Field:=3, Criteria1:="=" & ComboBoxCustomerAgent.Value
rng.AutoFilter Field:=14, Criteria1:="=" & DTPicker1.Value
rng.AutoFilter Field:=18, Criteria1:="= Open"
Set WSNew = Workbooks("Customer services test.xlsm").Worksheets("Sheet2")
ws.AutoFilter.Range.Copy
With WSNew.Range("A1")
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
'
Application.CutCopyMode = False
TextBoxWorkfortoday.Text = Cells(Rows.Count, 1).End(xlUp).Row - 1
End With
'
With ws.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then rng2.EntireRow.Delete
End With
ws.AutoFilterMode = False
destWB.Close SaveChanges:=True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Workbooks("Customer services test.xlsm").Worksheets("Sheet1").Activate
End Sub
I have 2 questions:
The autofilter is not filtering on all criteria?
And then not deleting those records that were filtered?
Any help?
Thanks
Albert