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​

 

[Osvaldo Palmeiro]

Hi.
I would go with Find function to get column numbers.

Sub FindColumns() 'Location, Salary, Apple & Cost
 Dim L As Long, S As Long, A As Long, C As Long
  L = Rows(1).Find("Location").Column
  S = Rows(1).Find("Salary").Column
  A = Rows(1).Find("Apple").Column
  C = Rows(1).Find("Cost").Column
End Sub

 

[kevin9999]

Personally I would use Advanced Filter to do this, which lends itself very well to specifying which columns you want to copy. Try this on a copy of your data, and change the sheet names for the source and destination to suit. Assumes your data starts in column A and row 1 is a header row.

Option Explicit
Sub Copy_Some_Columns()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")  '<~~ change to actual source sheet name
    Set ws2 = Worksheets("Sheet2")  '<~~ 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 SalCol As Long
    SalCol = WorksheetFunction.Match("Salary", 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 & "=2"
        .AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo
    End With
    
    'Tidy up
    ws2.Cells.Columns.AutoFit
    rngCriteria.ClearContents
End Sub

 

[Ananthak275]

Personally I would use Advanced Filter to do this, which lends itself very well to specifying which columns you want to copy. Try this on a copy of your data, and change the sheet names for the source and destination to suit. Assumes your data starts in column A and row 1 is a header row.

Option Explicit
Sub Copy_Some_Columns()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")  '<~~ change to actual source sheet name
    Set ws2 = Worksheets("Sheet2")  '<~~ 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 SalCol As Long
    SalCol = WorksheetFunction.Match("Salary", 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 & "=2"
        .AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo
    End With
  
    'Tidy up
    ws2.Cells.Columns.AutoFit
    rngCriteria.ClearContents
End Sub

This is amazing!!! Just one thing, Instead of moving it to a new sheet, how do i keep it in the file that contains the code? one file that contains the code and another that contains the data

 

[Ananthak275]

This is amazing!!! Just one thing, Instead of moving it to a new sheet, how do i keep it in the file that contains the code? one file that contains the code and another that contains the data

Personally I would use Advanced Filter to do this, which lends itself very well to specifying which columns you want to copy. Try this on a copy of your data, and change the sheet names for the source and destination to suit. Assumes your data starts in column A and row 1 is a header row.

Option Explicit
Sub Copy_Some_Columns()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")  '<~~ change to actual source sheet name
    Set ws2 = Worksheets("Sheet2")  '<~~ 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 SalCol As Long
    SalCol = WorksheetFunction.Match("Salary", 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 & "=2"
        .AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo
    End With
   
    'Tidy up
    ws2.Cells.Columns.AutoFit
    rngCriteria.ClearContents
End Sub

This is the code I'm working with. Using open_file_dialog to get the source data but also getting workbook and worksheet name that contains the macro code. Unfortunately im erroring out at "ws2.UsedRange.ClearContents" run time error "91" Object variable or with block variable not set. Any idea what the issue is?

Option Explicit
Global ws2 As Worksheet
Global ws1 As Worksheet
Public CFile As String
Public strFile As String
Public lastRow As Long

Sub open_file_dialog()
Dim strFile As String, CFile As String, ws1 As Worksheet, ws2 As Worksheet

CFile = Application.ActiveWorkbook.FullName
ActiveSheet.Select
Set ws1 = ThisWorkbook.Worksheets(1)

strFile = Application.GetOpenFilename()
Workbooks.Open (strFile)
ActiveSheet.Select
Set ws2 = ActiveSheet

End Sub

Sub GoToColumnAndSelectValues()
Dim ws1 As Worksheet, ws2 As Worksheet
'Set ws1 = Worksheets("Sheet1")
'Sheets.Add.Name = "Sheet2"
'Set ws2 = Worksheets("Sheet2")
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 SalCol As Long
SalCol = WorksheetFunction.Match("Salary", 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 & "=2"
.AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo
End With

'Tidy up
ws2.Cells.Columns.AutoFit
rngCriteria.ClearContents

End Sub

 

[kevin9999]

This is amazing!!! Just one thing, Instead of moving it to a new sheet, how do i keep it in the file that contains the code? one file that contains the code and another that contains the data

Now you're confusing me You'll need to tell me the name of the sheet (in the file that contains the code?) and the cell location where you want the imported data to go to.

 

[kevin9999]

Try this.

Option Explicit
Sub Copy_Some_Columns_V2()
    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 SalCol As Long
    SalCol = WorksheetFunction.Match("Salary", 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 & "=2"
        .AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo
    End With
    
    'Tidy up
    rngCriteria.ClearContents
End Sub

 

[Ananthak275]

Now you're confusing me You'll need to tell me the name of the sheet (in the file that contains the code?) and the cell location where you want the imported data to go to.

Sorry the file name that contains the code is "XmlTesting.xlsm" and sheet name is "Task Details". This is where i want the imported data to go. Cell location is A2 (wont be needing headers)

 

[Ananthak275]

Try this.

Option Explicit
Sub Copy_Some_Columns_V2()
    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 SalCol As Long
    SalCol = WorksheetFunction.Match("Salary", 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 & "=2"
        .AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo
    End With
   
    'Tidy up
    rngCriteria.ClearContents
End Sub

This is perfect, thank you!!

 

[Ananthak275]

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

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