|| Database functions | Macros and buttons | Extracting words from text ||
If you have a list of records contained in a range of cells it is possible to extract all records that meet a specified set of criteria and place them elsewhere in your workbook. For example in a list of names and personal details you could find everyone who works for a particular organisation and has a birthday in June. This is a much smarter alternative to sorting, resorting, copying and pasting the data.
If the filtering is an infrequent exercise it can be achieved using the Excel menu options but if the task is regularly required it may be worth writing a short macro program to simplify the process.
The option [Data] Sort and Filter | Advanced opens a dialog box (right) which enables you to copy particular records to another location within your workbook. The List range refers to your source data; the Criteria range to a range of cells containing the rules which determine the records to be selected; the Copy to range are the cells in which the extracted records are to be placed and must be on the same worksheet as the original data.
The criteria range works on the same basis as with Database functions like DSUM(). It is a range of cells headed by the field names against which you wish to set conditions. There are three types of conditions / criteria.
Wildcarding and greater than (>) or less than (<) operators can be used.
Advanced filters can be a simple way to extract a list of all of the unique values in a range - i.e. removing all duplicates. Simply enter the details into the Advanced Filter dialog box, leaving the criteria blank, adding a new cell at which to start copying the extracted values and finally selecting the 'Unique records only' tick box.
A macro can be used to automate the filtering process - identifying a List range, pre-programmed with the Criteria and the Copy to ranges. The results can be on a different worksheet than the original data.
The criteria in the above example have been set to select records with any Grade starting with 'XN4' and also a Period of 'M01' plus any records with a Surname starting with 'L' and a period of 'M02'. Up to 3 sets of (OR) criteria can be entered in this example although you could modify the macro and worksheet to accept more or fewer rows. The following macro program has been linked to a button (labelled 'My Filter') placed on the worksheet.
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 MUST be in a worksheet called 'Data'
' *** MODIFY AND SET YOUR OWN RANGES ON THE FOLLOWING DECLARATIONS ***
' cell Data!E2 contains the last row number of data [=COUNT(E4:E100)+3]
LastDataRow = Worksheets("data").Range("E2").Value
DataRng = "A3:E3" ' range of column headers for Data table
CritRng = "B2:F5" ' range of cells for Criteria table
ResultsRng = "B8:F8" ' range of headers for Results table
MaxResults = 1000 ' any value higher than the number of possible results
' **************** END OF DECLARATIONS *********************
' fix the data range to incorporate the last row
TopRow = Range(DataRng).Row
LeftCol = Range(DataRng).Column
RightCol = LeftCol + Range(DataRng).Columns.Count - 1
DataRng = Range(Cells(TopRow, LeftCol), Cells(LastDataRow, RightCol)).Address
' fix the results range to incorporate the last row
TopRow = Range(ResultsRng).Row
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, LeftCol), Cells(MaxResults, RightCol)).Address
' fix the criteria range and identify the last row containing any items
TopRow = Range(CritRng).Row
BottomRow = TopRow + Range(CritRng).Rows.Count - 1
LeftCol = Range(CritRng).Column
RightCol = LeftCol + Range(CritRng).Columns.Count - 1
CritRow = 0
For MyRow = TopRow + 1 To BottomRow
For MyCol = LeftCol To RightCol
If Cells(MyRow, MyCol).Value <> "" Then CritRow = MyRow
If CritRow = 0 Then
MsgBox "No Criteria detected", "MeadInKent"
CritRng = Range(Cells(TopRow, LeftCol), Cells(CritRow, RightCol)).Address
Debug.Print "DataRng, CritRng, ResultsRng: ", DataRng, CritRng, ResultsRng
Worksheets("Data").Range(DataRng).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range(CritRng), CopyToRange:=Range(ResultsRng), _
Would you like to learn more?
|A macro program to automate the Excel Advanced Filter. This can be copied and pasted into your own Excel module. Note that in my workbook there are two worksheets - 'Data' and 'Results'. The button is placed on the Results worksheet.|
Click to download this PDF document
|Get this information as a document
accompanied by Excel worksheets
|Click here for details about
file. It has been rewritten for Excel 2010.
|file: xlfilter.htm||Page last updated Feb14||© meadinkent.co.uk 2014||CMIDX S2 P4 Y|