Advanced Filter with Non-Contiguous Ranges

[John]

Is it possible to use non-contiguous ranges with the vba code for advanced
filters?

I can not get the example code to work.

Example of code:
Sub TestCode()
On Error GoTo Err_Text

Dim oWB As String
Dim oJoinNewRng01 As Range

oWB = Application.ActiveWorkbook.Name

Set oJoinNewRng01 =
Union(Workbooks(oWB).Sheets("Sheet1").Range("A10:A14"), Range("E10:G14"))

oJoinNewRng01.Select


oJoinNewRng01.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Workbooks(oWB).Sheets("Sheet1").Range("Criteria"), _
CopyToRange:=Workbooks(oWB).Sheets("Sheet1").Range("I10:L10"), _
Unique:=False

Exit_Text:
Exit Sub

Err_Text:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_Text

End Sub

 

[Tom Ogilvy]

why not just do

A10:G14

then after the copy delete the columns you don't want.

or try working with the whole range, but hide the columns B (untested)


but no, I believe it must be a contiguous range

 

[Droidy]

Is it possible to use non-contiguous ranges with the vba code for advanced
filters?

Try this:-

Sub Split_Areas()

Application.ScreenUpdating = False

Call SetNamedRange ' Creates a range called "Database",
works for any size

Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("Data") 'Change this to suit your
spreadsheet
Set rng = Range("Database")


Dim i As Integer


'extract a list of Areas, Columns A:A is where you non-contiguos range
is
'Using BL & BM here as it is sufficiently away from your data

ws1.Columns("A:A").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("BL1"), Unique:=True
r = Cells(Rows.Count, "BL").End(xlUp).Row


'set up Criteria Area
If Range("A1").HasFormula = True Then
Range("A1").Formula.Copy Destination:=Range("BM1")
Else
Range("A1").Copy Destination:=Range("BM1")
End If

For Each c In Range("BL2:BL" & r)
'add the area name to the criteria area
If ws1.Range("BM2").HasFormula Then
ws1.Range("BM2").Formula = c.Formula
Else
ws1.Range("BM2").Value = c.Value
End If
'add new sheet and run advanced filter
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.NAME = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Data").Range("BM1:BM2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False

Call Auto_Fit

Next
ws1.Select
ws1.Columns("BL:BM").Delete

Application.DisplayAlerts = False
ws1.Visible = xlSheetHidden
Application.DisplayAlerts = True

Rows("1:1").Select
Selection.Font.Bold = True

Call Auto_Fit

'Select "Whichever sheet you want to be selected first" Sheet

Sheets("Whichever sheet you want to be selected first").Select

Application.ScreenUpdating = True

End Sub

----------------------------------------------------------------------

' This sub courtesy of Deborah Dalgleish

Public Sub SetNamedRange()

ActiveWorkbook.Names.Add NAME:="Database", _
RefersTo:=Worksheets("Data").UsedRange

End Sub

----------------------------------------------------------------------