Extracting Records with VBA

Extracting Records with VBA

Start File

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:

1. By using a conditional statement inside a loop
2. 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.

1. Identify the Last Row of Source Data by declaring a variable (LastSourceRow)
2. Identify the last Row of Extracted Records (Destination) by declaring a second variable (LastDestinationRow)
3. Declare a third variable to be used for looping (LoopCounter)
4. Select a known point (Say A1)
5. 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:
   1. Range(“K2”).Resize(LastDestinationRow, 6).ClearContents
   2. Range(“K2”).Resize(500, 6).ClearContents
6. Create a For… Next Loop to repeat the same instructions starting from row 2 to the LastSourceRow:
   1. For LoopCounter= 2 To LastSourceRow ……..Next LoopCounter
   2. Evaluate the 2 conditions with an IF Statement & AND
   3. If the 2 conditions are met:
      1. Copy the record using Range, Cells and LoopCounter
      2. Find the Last Destination Row in column 11 (Column K)
      3. Move one Row down and Paste the copied record (xlPasteFormulasAndNumberFormats)
      4. End the conditional statement
      5. Close the Loop
   4. Select cell K1
   5. End the Sub procedure

Part 2 Running the code when there is a change in the conditions (H2 or I2)

1. Right Click the sheet Tab and select “View Code”
2. From the drop lists change to “Worksheet” & “Change” Event
3. Set the 2 conditions of the Target Cell in an IF statement
4. 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:

• • • 1. We identify the last row of source data
      2. Clear result of previous filter
      3. 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