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

User · Answer

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

User · Answer

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

User · Answer

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

User · Answer

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  amp  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  amp  continue to search for your criteria             Sheets  Sheet1   Select       End If Next r End Sub

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

Examples related to vba

Examples related to loops

Examples related to excel