Vba macro to copy row from table if value in table meets condition

Question

i'm trying to make a macro which:

goes through a table
looks if value in column B of that table has a certain value
if it has, copy that row to a range in an other worksheet

The result is similar to filtering the table but I want to avoid hiding any rows

I'm kinda new to vba and don't really know where to start with this, any help much appreciated.

Use the macro recorder, inspect the code, and adjust the code along this: http://stackoverflow.com/questions/12138624/vba-copy-paste-with-dynamic-range/12139101 — JohnB, Aug 29 '12 at 11:47

score 6 · Accepted Answer · answered Aug 29 '12 at 19:44

That is exactly what you do with an advanced filter. If it's a one shot, you don't even need a macro, it is available in the Data menu.

Sheets("Sheet1").Range("A1:D17").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Sheet1").Range("G1:G2"), CopyToRange:=Range("A1:D1") _
    , Unique:=False

Toni Kanoni · Answer 2 · 2012-08-29T12:05:59.553

Try it like this:

Sub testIt()
Dim r As Long, endRow as Long, pasteRowIndex As Long

endRow = 10 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1

For r = 1 To endRow 'Loop through sheet1 and search for your criteria

    If Cells(r, Columns("B").Column).Value = "YourCriteria" Then 'Found

            'Copy the current row
            Rows(r).Select 
            Selection.Copy

            'Switch to the sheet where you want to paste it & paste
            Sheets("Sheet2").Select
            Rows(pasteRowIndex).Select
            ActiveSheet.Paste

            'Next time you find a match, it will be pasted in a new row
            pasteRowIndex = pasteRowIndex + 1


           'Switch back to your table & continue to search for your criteria
            Sheets("Sheet1").Select  
    End If
Next r
End Sub

Steve · Answer 3 · 2012-08-29T19:28:51.287

Selects are slow and unnescsaary. The following code will be far faster:

Sub CopyRowsAcross() 
Dim i As Integer 
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1") 
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2") 

For i = 2 To ws1.Range("B65536").End(xlUp).Row 
    If ws1.Cells(i, 2) = "Your Critera" Then ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1) 
Next i 
End Sub

Jook · Answer 4 · 2012-08-29T15:14:30.070

you are describing a Problem, which I would try to solve with the VLOOKUP function rather than using VBA.

You should always consider a non-vba solution first.

Here are some application examples of VLOOKUP (or SVERWEIS in German, as i know it):

http://www.youtube.com/watch?v=RCLUM0UMLXo

http://office.microsoft.com/en-us/excel-help/vlookup-HP005209335.aspx

If you have to make it as a macro, you could use VLOOKUP as an application function - a quick solution with slow performance - or you will have to make a simillar function yourself.

If it has to be the latter, then there is need for more details on your specification, regarding performance questions.

You could copy any range to an array, loop through this array and check for your value, then copy this value to any other range. This is how i would solve this as a vba-function.

This would look something like that:

Public Sub CopyFilter()

  Dim wks As Worksheet
  Dim avarTemp() As Variant
  'go through each worksheet
  For Each wks In ThisWorkbook.Worksheets
        avarTemp = wks.UsedRange
        For i = LBound(avarTemp, 1) To UBound(avarTemp, 1)
          'check in the first column in each row
          If avarTemp(i, LBound(avarTemp, 2)) = "XYZ" Then
            'copy cell
             targetWks.Cells(1, 1) = avarTemp(i, LBound(avarTemp, 2))
          End If
        Next i
  Next wks
End Sub

Ok, now i have something nice which could come in handy for myself:

Public Function FILTER(ByRef rng As Range, ByRef lngIndex As Long) As Variant
  Dim avarTemp() As Variant
  Dim avarResult() As Variant
  Dim i As Long
  avarTemp = rng

  ReDim avarResult(0)

  For i = LBound(avarTemp, 1) To UBound(avarTemp, 1)
      If avarTemp(i, 1) = "active" Then
        avarResult(UBound(avarResult)) = avarTemp(i, lngIndex)
        'expand our result array
        ReDim Preserve avarResult(UBound(avarResult) + 1)
      End If
  Next i

  FILTER = avarResult
End Function

You can use it in your Worksheet like this =FILTER(Tabelle1!A:C;2) or with =INDEX(FILTER(Tabelle1!A:C;2);3) to specify the result row. I am sure someone could extend this to include the index functionality into FILTER or knows how to return a range like object - maybe I could too, but not today ;)

Yes, indeed VLOOKUP has the same functionality. But the problem is that my criteria is a fixed value, namely the word "active". As a result I always get the same entry from the table(the first one) corresponding with "active" in column B, and not all the rows with "active" (e.g. VLOOKUP("active";Table1;3;FALSE) will always return the same value) — andrew b, Aug 29 '12 at 12:42
Not necessarily. e.g. VLOOKUP("active";$A1:$Z1;FALSE), this would need filtering only on the result side or further adjustment with range offsets and sorted input. Your problem is just a bit different than my first understanding of it. My given vba-code needs some adjustment too, but if performance is the question, I would prefer it to any "select" solution. One could make a worksheet-function to filter range input and returning a result matrix or any specific part of its result matrix. — Jook, Aug 29 '12 at 14:47

Vba macro to copy row from table if value in table meets condition

4 Answers4

Linked