locked
Adding additional criteria to VBA code for copying rows from data Set RRS feed

  • Question

  • Hey guys I am using the code below to copy rows from sheet1 to sheet 3 using a single criteria set defined in Column O by "r=UserForm2/ListBox1.Text".  What I would like to do is copy rows based on multiple criteria, up 6, which would be defined by additional ListBoxes. Note sure if I need a combination of If statements.  See code below:

    Private Sub CommandButton1_Click()
    Sheet3.Cells.Clear
    Sheets("Sheet3").Select
       Const Source As String = "Sheet1"
       Const Destination As String = "Sheet3"
       Const ColumnsToSearch As String = "O:O"
       Const DataStartRow As Long = 2
       Application.ScreenUpdating = False
       With Worksheets(Source)
         Intersect(.Rows("1:" & DataStartRow - 1), .Range(ColumnsToSearch)). _
                         EntireRow.Copy Worksheets(Destination).Range("A1")
         With .Range(ColumnsToSearch)
            r = UserForm2.ListBox1.Text
           .Replace r, "#N/A", xlWhole
           With .SpecialCells(xlCellTypeConstants, xlErrors)
             .Value = r
             .EntireRow.Copy Worksheets(Destination).Cells(DataStartRow, "A")
           End With
           Worksheets(Destination).Range(ColumnsToSearch). _
                    ColumnWidth = .Columns(1).ColumnWidth
         End With
       End With
       Application.ScreenUpdating = True
       Unload UserForm2
     End Sub

    Wednesday, August 14, 2013 7:59 PM

All replies

  • Your idea of using error is quite unique.

    But if you want to copy row when all 6 criteria met then I suggest to use filter method. Because multiple find will be very complicated.

    You must have some mapping of columns and values required for that column.Paste that or upload some sample workbook in skydrive.


    Best Regards,
    Asadulla Javed, Kolkata
    ---------------------------------------------------------------------------------------------
    Please do not forget to click “Vote as Helpful” if any post helps you and "Mark as Answer”if it solves the issue.

    Friday, August 16, 2013 6:21 AM
    Answerer