Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel advancedfilter macro returning same row every time

Status
Not open for further replies.

jjfjr

Programmer
Mar 10, 2004
13
US
Hi;

I have a workbook with two sheets: Data and Results. My search button on the Results sheet will see what criteria has been entered in the criteria section of Results and then display rows in the Data sheet that match the Criteria. The matching rows are displayed in the Result section of the Result sheet.

While I can enter a value in the criteria range and get a response, whenever I clear the criteria and enter other values, the search always returns the same row; the first row in the 'data' sheet. I want to be able to both enter values in the same column in Criteria (values are ORed together) and values in different columns (values are ANDed together)

The bulk of the code follows. The MsgBox messages are there to echo back the various values that variables currently hold. Any ideas? All help is greatly appreciated.


Private Sub Search_Click()

Dim MaxResults As Integer, MyCol As Integer, ResultsRng As String
Dim MyRow As Integer, LastDataRow As Integer, DataRng As String
Dim CritRow As Integer, CritRng As String, RightCol As Integer
Dim TopRow As Integer, BottomRow As Integer, LeftCol As Integer

' the source data is in a worksheet called 'Data'

' *** MODIFY AND SET YOUR OWN RANGES ON THE FOLLOWING DECLARATIONS ***

' cell Data!E1 contains the last row number of data [=COUNT(E4:E100)+3]

MsgBox "Before declarations"
MsgBox LastDataRow
MsgBox Worksheets("Data").Range("E1").Value
LastDataRow = Worksheets("Data").Range("E1").Value
MsgBox LastDataRow

DataRng = "A3:H3" ' range of column headers for Data table
CritRng = "B3:I5" ' range of cells for Criteria table
ResultsRng = "B8:I8" ' range of headers for Results table
MaxResults = 1000 ' any value higher than the number of possible results
MsgBox "After declarations"
' **************** END OF DECLARATIONS *********************


' fix the data range to incorporate the last row
MsgBox "Before data range fix"
TopRow = Worksheets("Data").Range(DataRng).Row
MsgBox "TopRow= " & TopRow

LeftCol = Range(DataRng).Column
RightCol = LeftCol + Range(DataRng).Columns.Count - 1
DataRng = Range(Cells(TopRow, LeftCol), Cells(LastDataRow, RightCol)).Address
MsgBox "After data range fix"
' fix the results range to incorporate the last row

TopRow = Worksheets("Data").Range(ResultsRng).Row
MsgBox "TopRow= " & TopRow
LeftCol = Range(ResultsRng).Column
RightCol = LeftCol + Range(ResultsRng).Columns.Count - 1
ResultsRng = Range(Cells(TopRow + 1, LeftCol), Cells(MaxResults,
RightCol)).Address
Range(ResultsRng).ClearContents ' clear any previous results but not headers
ResultsRng = Range(Cells(TopRow + 1, LeftCol), Cells(MaxResults,
RightCol)).Address

' fix the criteria range and identify the last row containing any items

TopRow = Range(CritRng).Row
MsgBox "TopRow= " & TopRow
BottomRow = TopRow + Range(CritRng).Rows.Count - 1
MsgBox "BottomRow= " & BottomRow
LeftCol = Range(CritRng).Column
MsgBox "LeftCol= " & LeftCol
RightCol = LeftCol + Range(CritRng).Columns.Count - 1
MsgBox "RightCol= " & RightCol
CritRow = 0

For MyRow = TopRow To BottomRow
MsgBox "MyRow=" & MyRow
For MyCol = LeftCol To RightCol
MsgBox "MyCol=" & MyCol
MsgBox "Cells(MyRow,MyCol).Value=" & Cells(MyRow, MyCol).Value
If Cells(MyRow, MyCol).Value <> "" Then CritRow = MyRow
MsgBox "CritRow= " & CritRow
Next
Next

MsgBox &quot; Before If CritRow= &quot; &amp; CritRow

If CritRow = 0 Then
MsgBox "No Criteria detected"
Else
CritRng = Range(Cells(TopRow - 1, LeftCol), Cells(CritRow, RightCol)).Address
MsgBox "DataRng= " & DataRng
MsgBox "CritRng= " & CritRng
MsgBox "ResultsRng= " & ResultsRng
MsgBox "Worksheets(Results).Range(CritRng)= " &
Worksheets("Results").Range(CritRng).Address

Worksheets("Data").Range(DataRng).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Worksheets("Results").Range(CritRng),
CopyToRange:=Worksheets("Results").Range(ResultsRng), _
Unique:=True
End If
Range(&quot;A5&quot;).Select
End Sub

 
I haven't tried to follow your code but it sounds as if you just need to look at your advanced filter criteria.
Either the criteria are wrong or the range you are specifying as containing the criteria is wrong.

Put a break into your code after the advanced filter and watch
CriteriaRange.address
and
Worksheets("Data").Range(DataRng).address

If these appear to be correct?
Then having finished the macro try manually running advanced filter using those addresses (or your named ranges). Does it still give unespected results? If so surely it is your criteria you need to refine first - then worry about getting the code to populate it.

I would suggest that you actually name the ranges. E.G.
Range(B3:I5).name=Criteria
No, your criteria range keeps changing size/shape so assuming top left of criteria is always b3 and the criteria range is separated by blank cells from any other data:
Range(b3).currentregion.name=criteria


Thanks,

Gavin
 
Hm I think you could use the .CurrentRegion a fair bit in your code - or dynamic named ranges.
To see what .CurrentRegion does you can select a cell and apply it manually:
Edit,goto,special
There is also a toolbar button that saves you going through that tortuous route but that's another story.

Thanks,

Gavin
 
Hi;

I tried your idea for tracking CriteriaRange.address
and Worksheets("Data").Range(DataRng).address. I was able to figure a few things out and I seem to get all unique rows. This works if I put one value in one column or multiple values in one column so that they are ORed together. However, when I try to put a value in more that one column so that they are ANDed, no result is returned.

Also, when I do a search in addition to the selected rows, the row of column headers in the "data" sheet is also pulled in. Any ideas?

Thanks
 
the row of column headers in the "data" sheet is also pulled in. Any ideas?"
The only reasons I can think of are:
a) that your source has the headers twice - maybe in a hidden row?
b) that your code is doing something unintended - so try applying the advanced filter manually.

Try simplifying your sourcedata for test purposes. EG delete all but the header row and 3 rows. Does the advance filter still bring in the header as well?

"However, when I try to put a value in more that one column so that they are ANDed, no result is returned."
I assume that you are certain that some data meets the criteria. Maybe

I think you need to:
1)check that the named range "criteria" covers your criteria range.
2)check if the filter works if operated manually
assuming that it doesn't then (iii)post the criteria here (or maybe in the office forum) and someone will no doubt help you to resolve the issue.

Thanks,

Gavin
 
I tried to run the advanced filter manually with the following:

List range: Data!$A$2:$H$11
Criteria Range: Results!$B$2:$I$5
Copy to: Results!$B$9:$I$1000

It produced this message:

Extract range has missing or invalid field name.


I looked at all fields and they seem to be intact. Any help is appreciated.
 
When filtering to a different sheet it really helps to use named ranges. However, I don't think that is your problem.

Data!$A$2:$H$2 should have an entry in every cell. I seem to remember that it doesn't like some unusual characters in the headings.

Copy to: Results!$B$9:$I$1000 is probably the problem. you should only specify the heading row, ie
Results!$B$9:$I$9
Again there should be a value in every cell AND these should replicate headings from your data sheet.

Criteria range should be fully occupied.

Thanks,

Gavin
 
Hi;

I tried your modifications and it seemed to work - partially. WI was a little surprised to hear that every cell had to be occupied. I was trying to use a modified version of the code I found on seemed to indicated that filling all cells wasn't neccessary. What do you think?

Thanks;
 
not every cell. But ALL cells in the Headings (field names) of your table (database) and all cells in your Extract range (list of fields you want in the extracted data.

For the criteria range the whole rectangle has to be relevant. In some scenarios you don't use field headings. Certainly some.

Thanks,

Gavin
 
As for your link. Well there are many ways to make life easier. I prefer to use a set of standard range names and a much simpler bit of code:
Code:
Sub AdvancedFilter()
'
' This macro looks for the named range 'Criteria' _
    adjusts that name to the current region (bounded by blank cells) - _
    this is so that the criteria can be modified without needing to worry _
    about re-defining the range _
    Finally an advanced filter to a new location is run _
        using tthe named range "alldata" as the source _
        the named range "criteria" as the criteria
        the named range output as the plact to filter to _
            "output" should be the list of the column headings you want to extract
            
'Usually you will run this macro from the sheet containing the "output" and "criteria" ranges _
this avoids abiguity.  There should be only one range called Alldata in the workbook.

    Application.GoTo Reference:="Criteria"
    Selection.CurrentRegion.Name = "Criteria"
    Range("alldata").AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=Range("Criteria").CurrentRegion, _
        CopyToRange:=Range("output"), _
        Unique:=False

End Sub

Thanks,

Gavin
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top