VBA - filter based on specific value then copy relevant values in other columns

[Ananthak275]

Hi,

I have this dataset which has the following columns Location, Salary, Trees, Apple, Cost, Jack. I'm looking to be able to;

1. Go to column "Salary".
2. Filter for values = 2 in Salary Column
3. Then extract only values from Location, Salary, Apple & Cost. NOT JACK and TREEs

Also, the column location changes sometimes so i'm using this (see below). is there an easier way to get the location of Location, Salary, Apple & Cost

Sub GoToColumn()

Set CWS = ActiveSheet
AColNum = Application.WorksheetFunction.Match("Salary", CWS.Rows(1), 0)
Cells(1, AColNum).Select

Example of dataset:

Location	Salary	Trees	Apple	Cost	Jack
Washington	1​	0.78​	No	0.99​	0.87​
Washington	1​	0.60​	No	0.42​	0.51​
Washington	1​	0.17​	No	0.81​	0.86​
Washington	1​	0.68​	No	0.58​	0.64​
Washington	1​	0.34​	No	0.19​	0.31​
Washington	1​	0.72​	No	0.87​	0.48​
New York	2​	0.59​	Yes	0.24​	0.63​
New York	2​	0.79​	Yes	0.87​	0.96​
New York	2​	0.08​	Yes	0.46​	0.83​
New York	2​	0.66​	Yes	0.20​	0.30​
Washington	3​	0.45​	No	0.35​	0.12​
Washington	3​	0.34​	No	0.88​	0.87​
Washington	4​	0.02​	No	0.57​	0.41​
Washington	4​	0.37​	No	0.21​	0.23​

 

[kevin9999]

This is perfect, thank you!!

Happy to help, and thanks for the feedback

 

[kevin9999]

Can you explain what this equation is used for? Specifically the "=RC"

This sets the filter criteria, specifically that the Salary column is "2".
The RC reference method refers to row (R) and column (C) numbers relative to the cell where the formula is entered. There's no number following the R therefore it's referring to the same row the formula is on. The SalCol following the C is the column number where Salary was found using Match earlier in the code. Hope that helps.

 

[kevin9999]

R1C1-Style Notation And FormulaR1C1 Property In Excel VBA

 

[Ananthak275]

This sets the filter criteria, specifically that the Salary column is "2".
The RC reference method refers to row (R) and column (C) numbers relative to the cell where the formula is entered. There's no number following the R therefore it's referring to the same row the formula is on. The SalCol following the C is the column number where Salary was found using Match earlier in the code. Hope that helps.

R1C1-Style Notation And FormulaR1C1 Property In Excel VBA

If the filter criteria wasn't a number and instead wanted to make it a string, would i need to change RC?

 

[kevin9999]

If the filter criteria wasn't a number and instead wanted to make it a string, would i need to change RC?

No, just wrap it in double quotation marks "*"

 

[Ananthak275]

No, just wrap it in double quotation marks "*"

This is giving me the error "1004"

rngCriteria.Cells(2).FormulaR1C1 = "=RC" & SalCol & "Apple"

 

[kevin9999]

This is giving me the error "1004"

You don't have anything in your sample source data (from row 2 downwards) that contains "Apple". The Apple column only contains Yes or No.

 

[Ananthak275]

You don't have anything in your sample source data (from row 2 downwards) that contains "Apple". The Apple column only contains Yes or No.

Apologies. This is running without error but not giving me any values in the output other than the headers. I changed SalCol ="Apple".

Dim SalCol As Long
SalCol = WorksheetFunction.Match("Apple", ws1.Rows(1), 0)
Set rngList = ws1.Range("A1").CurrentRegion
With rngList
Set rngCriteria = rngList.Offset(, .Columns.Count).Resize(2, 1)
rngCriteria.Cells(2).FormulaR1C1 = "=RC" & SalCol & "=Yes"
.AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo
End With

 

[kevin9999]

OK, let's try a different approach, without the formula but still using Advanced Filter.

Option Explicit
Sub Copy_Some_Columns_V3()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim strFile As String
    strFile = Application.GetOpenFilename()
    Workbooks.Open (strFile)
    Set ws1 = ActiveWorkbook.Sheets(1)
    
    Set ws2 = ThisWorkbook.Worksheets("Sheet1")  '<~~ Change to actual destination sheet name
    Dim rngList As Range, rngCriteria As Range, rngCopyTo As Range
    
    'Get the copy to destination
    ws2.UsedRange.ClearContents
    Set rngCopyTo = ws2.Range("A1").Resize(1, 4)
    rngCopyTo.Value2 = Array("Location", "Salary", "Apple", "Cost")
    
    'Filter and copy
    Dim HdrStr As String
    HdrStr = "Apple"                                '<~~ Change to whatever column you're interested in
    Set rngList = ws1.Range("A1").CurrentRegion
    With rngList
        Set rngCriteria = rngList.Offset(, .Columns.Count).Resize(2, 1)
        rngCriteria.Cells(1).Value2 = HdrStr
        rngCriteria.Cells(2).Value2 = "Yes"         '<~~ Change to whatever value you want to filter on
        .AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo
    End With
    
    'Tidy up
    rngCriteria.ClearContents
End Sub

 

[kevin9999]

Code could actually be shortened somewhat to this...

Option Explicit
Sub Copy_Some_Columns_V4()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim strFile As String
    strFile = Application.GetOpenFilename()
    Workbooks.Open (strFile)
    Set ws1 = ActiveWorkbook.Sheets(1)
    
    Set ws2 = ThisWorkbook.Worksheets("Sheet1")  '<~~ Change to actual destination sheet name
    Dim rngList As Range, rngCriteria As Range, rngCopyTo As Range
    
    'Get the copy to destination
    ws2.UsedRange.ClearContents
    Set rngCopyTo = ws2.Range("A1").Resize(1, 4)
    rngCopyTo.Value2 = Array("Location", "Salary", "Apple", "Cost")
    
    'Filter and copy
    Set rngList = ws1.Range("A1").CurrentRegion
    With rngList
        Set rngCriteria = rngList.Offset(, .Columns.Count).Resize(2, 1)
        rngCriteria.Cells(1).Value2 = "Apple"       '<~~ Change to whatever column you're interested in
        rngCriteria.Cells(2).Value2 = "Yes"         '<~~ Change to whatever value you want to filter on
        .AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo
    End With
    
    'Tidy up
    rngCriteria.ClearContents
End Sub