Extracting Records with VBA
One of the most common tasks we do in Excel is to extract records based upon conditions we specify. In this post I show you 2 different methods to extract records:
- By using a conditional statement inside a loop
- By using an advanced filter in VBA
In our sample file we have a list that shows a “Date”, a “Region”, a “Representative”, “Customer”, “COGS” and “Sales”. We also have 2 drop lists (Data Validation Lists) in cells “H2” and “I2”. We want to be able to change our selection from any of the 2 drop lists and have the corresponding records meeting our conditions to be extracted outside the original list in cell K1.
Method One: Conditional Statement & Looping over instructions
Source Data
Criteria
Destination
Part 1 Extracting Records by looping over instructions
Switch to the Visual Basic Editor by hitting ALT + F11
Create a module by clicking on the insert menu and select module.
- Identify the Last Row of Source Data by declaring a variable (LastSourceRow)
- Identify the last Row of Extracted Records (Destination) by declaring a second variable (LastDestinationRow)
- Declare a third variable to be used for looping (LoopCounter)
- Select a known point (Say A1)
- Clear the previously extracted values in Columns K to P, From Row 2 up to the last row identified by the Variable.
To do that we’ll use the “Resize” Statement:- Range(“K2”).Resize(LastDestinationRow, 6).ClearContents
- Range(“K2”).Resize(500, 6).ClearContents
- Create a For… Next Loop to repeat the same instructions starting from row 2 to the LastSourceRow:
- For LoopCounter= 2 To LastSourceRow ……..Next LoopCounter
- Evaluate the 2 conditions with an IF Statement & AND
- If the 2 conditions are met:
- Copy the record using Range, Cells and LoopCounter
- Find the Last Destination Row in column 11 (Column K)
- Move one Row down and Paste the copied record (xlPasteFormulasAndNumberFormats)
- End the conditional statement
- Close the Loop
- Select cell K1
- End the Sub procedure
Part 2 Running the code when there is a change in the conditions (H2 or I2)
- Right Click the sheet Tab and select “View Code”
- From the drop lists change to “Worksheet” & “Change” Event
- Set the 2 conditions of the Target Cell in an IF statement
If a change happens in the Target it will call the ExtractRecords procedure.
Sub ExtractRecords()
Dim LastSourceRow As Integer
Dim LastDestinationRow As Integer
Dim LoopCounter As Integer
LastSourceRow = Cells((Rows.Count), 1).End(xlUp).Row
LastDestinationRow = Cells((Rows.Count), 11).End(xlUp).Row
Range(“A1”).Select
Range(“K2”).Resize(500, 6).ClearContents
For LoopCounter = 2 To LastSourceRow
If Cells(LoopCounter, 2).Value = Range(“H2”).Value And Cells(LoopCounter, 3).Value = Range(“I2”) Then
Range(Cells(LoopCounter, 1), Cells(LoopCounter, 6)).Copy
LastDestinationRow = Cells((Rows.Count), 11).End(xlUp).Row
Cells(LastDestinationRow, 11).Offset(1, 0).Select
ActiveCell.PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next LoopCounter
Range(“K1”).Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range(“H2”).Address Or Target.Address = Range(“I2”).Address Then
Call ExtractRecords
End If
End Sub
Method Two: Using an advanced Filter in VBA
Switch to the Visual Basic Editor by hitting ALT + F11
Create a module by clicking on the insert menu and select module.
Create the following subroutine in which:
- We identify the last row of source data
- Clear result of previous filter
- Extract records based upon criteria in cells H2 & I2
Sub FilterForm()
lastRow = Range(“A1”).End(xlDown).Row
Range(“K1”).CurrentRegion.ClearContents
Range(“A1”).Resize(lastRow, 6).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(“H1:I2”), CopyToRange:= Range(“K1”), Unique:=False
End Sub
Range(“A1”).Resize(lastRow, 6)
Action:=xlFilterCopy
CriteriaRange:=Range(“H1:I2”)
CopyToRange:= Range(“K1”)
Unique:=False
To automatically trigger the code:
We need to attach the code to the change event of cells H2 & I2
- Right click on the worksheet Tab and select “View Code”
- There are 2 drop lists at the top of the module: From the left one select “Worksheet” and from the right one select “Change”
- Copy and paste the code below between the Private Sub and End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range(“H2”).Address Or Target.Address = Range(“I2”).Address Then
Call FilterForm
End If
End Sub