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​

 

[Ananthak275]

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

Hi @kevin9999 can you tell me what this part means

AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo

My destination sheet after Column D are protected and it errors out at this part of the code. Is there a work around? My error says “you cannot use this command on a protected sheet”

 

[kevin9999]

can you tell me what this part means

This is the command line to apply the AdvancedFilter
xlFilterCopy means you intend to copy the filtered data to another place (as opposed to xlFilterInPlace)
rngCriteria is the range that contains the criteria you intend to filter by
rngCopyTo is where you want the filtered data copied to (the destination)
Both rngCriteria and rngCopyTo are set earlier in the code

If you intend copying the data to a protected sheet, you will need to unprotect it first. You can place something like this before the AdvancedFilter command line:

DestinationSheet.Unprotect "password"

and then before the end of the code:

DestinationSheet.Protect "password"

changing the DestinationSheet and "password" to whatever you are using for those.

 

[Ananthak275]

This is the command line to apply the AdvancedFilter
xlFilterCopy means you intend to copy the filtered data to another place (as opposed to xlFilterInPlace)
rngCriteria is the range that contains the criteria you intend to filter by
rngCopyTo is where you want the filtered data copied to (the destination)
Both rngCriteria and rngCopyTo are set earlier in the code

If you intend copying the data to a protected sheet, you will need to unprotect it first. You can place something like this before the AdvancedFilter command line:

DestinationSheet.Unprotect "password"

and then before the end of the code:

DestinationSheet.Protect "password"

changing the DestinationSheet and "password" to whatever you are using for those.

I don't understand why it errors out, I've made sure that A-D aren't protected columns only after and that is where the data is being coped to in the destination file.

Is there another way without the password?

 

[kevin9999]

I don't understand why it errors out, I've made sure that A-D aren't protected columns only after and that is where the data is being coped to in the destination file.

Is there another way without the password?

Password is optional. Without seeing your actual file, it's very difficult to pinpoint where the problem arises. Can you share via Dropbox or something similar?

 

[Ananthak275]

instead of this part, is there a work around? maybe by matching columns to columns and putting the value there?

'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