asked on

VBA to determine criteria of AutoFilter

I have a Project Cost reporting Excel file in use by a number of Project Managers.

A feature which I have installed on these files is an option to add additional rows of data at the click of a button rather than inserting them manually. Doing it by VBA ensures that all of the various calculations in each row are correctly copied into the new rows.

This works fine until one of the PMs reported an issue today. If an AutoFilter has been applied and thereby hiding rows the script throws an error.

I have built a workaround with a Warning message and basically fill the visible cells of a blank column with ###, show all data, run the insert code, reapply the filter on the ### column and then delete the ### entries, thus restoring the visible appearance of the filtered data.

The relevant lines of the code are shown below.

I have just showed this to a colleague and he pointed out that the filter is now on column A, the little funnel symbol on the AutoFilter dropdown shows it. Do we know what was filtered before?

So, my question is, can we determine the Filter Criteria in VBA? I can scan across and look for the Funnel symbol and check the criteria manually but can that be done automagically?

Although the filter is applied from columns A to CN, I suspect the Filter Criteria will be in columns B to X as these are the columns that the PM will be dealing with; the remaining columns are cost profiling calculations.

If there isn't a "simple" solution, I will stick with what I have and will allow for it in the Guidance Notes which I am also compiling.

Many thanks
Rob H

    CR = ActiveCell.Row
    CC = ActiveCell.Column
    LR = Range("LastRow").Row
    Range("A16:A" & LR).Select
    FullCount = Selection.Cells.Count
    VisCount = Selection.SpecialCells(xlVisible).Count
    Cells(CR, CC).Select
    If FullCount <> VisCount Then
        Check = MsgBox("There is a Filter in place. Please double check position of cursor." & Chr(10) _
                    & "Rows will be inserted above current position." & Chr(10) _
                    & "Filter will be re-applied after rows are inserted.", vbOKCancel, "Filter Check")
        If Check = vbCancel Then Exit Sub
    End If

.....Code to Insert Rows....

    LR = Range("LastRow").Row
    ActiveSheet.Range("$A$15:$CN$" & LR).AutoFilter Field:=1, Criteria1:="###"
    Range("A16:A" & LR).ClearContents

Open in new window

Professor J

Rob,

good to see that you asked a question. as most of the time, i see you answering the questions :)

so on your question

So, my question is, can we determine the Filter Criteria in VBA? I can scan across and look for the Funnel symbol and check the criteria manually but can that be done automagically?

please see attached UDF. the UDF returns the filter criteria for Filter. if it returns {*} means no filter in that column.

also please note that VBA cannot return the filter criteria for Dates that is a bug and Microsoft is aware of it.
EE.xlsm

Rob Henson

ASKER

Hi Prof, only on phone now. Might get chance to look at file over the weekend otherwise it will be on Monday.

Thanks
Rob

Roy Cox

A feature which I have installed on these files is an option to add additional rows of data at the click of a button rather than inserting them manually. Doing it by VBA ensures that all of the various calculations in each row are correctly copied into the new rows.

Data formatted as a Table will do this without VBA. You can also set this up in Excel Options if you don't want to use a Table

Rob Henson

ASKER

Hi Roy,

Unfortunately, a table wouldn't work as the blocks of data with the formulae are contiguous.

Thanks
Rob

Rob Henson

ASKER

HI Prof,

Didn't get chance over the weekend, no surprise, but now can't download an xlsm at work. Can you copy into a text file and upload that instead? I can then copy into a module to test the UDF.

Thanks
Rob

Rob Henson

ASKER

@Roy - oops, missed an important word from my comment for you, they are NOT contiguous.

Professor J

hi Rob,

here is the UDF

Function FilterCriteria(Rng As Range) As String
 Application.Volatile
Dim Filter As String

Filter = "{"
On Error GoTo Finish
With Rng.Parent.AutoFilter

If Intersect(Rng, .Range) Is Nothing Then GoTo Finish
With .Filters(Rng.Column - .Range.Column + 1)
If Not .On Then GoTo Finish
FilterString = .Criteria1

If IsArray(FilterString) Then

FilterUpper = UBound(FilterString)
FilterLower = LBound(FilterString)
If FilterString(FilterUpper) = "=" Then FilterUpper = FilterUpper - 1
For i = FilterLower To FilterUpper
Filter = Filter + Replace(FilterString(i), "=", "")
If i < FilterUpper Then Filter = Filter + ","
Next
Else

On Error GoTo missing
If IsMissing(.Criteria2) Then

missing: If .Criteria1 <> "=" Then
Filter = Filter + Replace(.Criteria1, "=", "")
End If
Else

Filter = Filter + Replace(.Criteria1, "=", "")
If .Criteria2 <> "=" Then
Filter = Filter + "," + Replace(.Criteria2, "=", "")
End If
End If
End If
End With
End With
Finish:

If Len(Filter) = 1 Then
Filter = Filter + "*"
End If

FilterCriteria = Filter + "}"
End Function

Open in new window

Rob Henson

ASKER

Hi ProfJJ,

Thanks for the update. I am not convinced I am going to be able to use this but I could be persuaded.

Does this work for dates? Some of the columns that might have a filter applied contain dates, eg Task Start and Finish Dates, Invoice Date etc. The filter might be applied to show tasks that are within the current year. When I apply the UDF to a Date column and then filter on that column it gives a number, for example filtering for "This Year" gives {13}.

Can I convert it to part of the main macro removing and re-applying the filter? I am thinking I could use an EVALUATE statement for each column in the range where I believe the filter will be used, capturing each result into an array; either with a column identifier or an array value for each column with the {*} for those where no filter is applied. How do I then use the Array to re-apply the filter?

Thanks
Rob H

EDIT: Just seen original comment about dates.

Roy Cox

Hi Rob

You had mean wondering!

ASKER CERTIFIED SOLUTION

Professor J

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Rob Henson

ASKER

Hi ProfJJ,

Thanks for the help with this, much appreciated.

Cheers
Rob

Professor J

you are welcome Rob.

cheers,
ProfJJ