Search & Copy function based on criteria that EXCLUDES invalid entries

[idlewyld89]

Alright so I feel like I'm 90% there... there's one particular problem in the routine.

Ultimately, I'm trying to increment through a dataset of 7000+ rows, search a defined column for a defined criteria, and then copy the entire row to a new sheet if that criteria is true within the searched cell.

The problem I'm having is that, in addition to the searched criteria, the code also copies over invalid entries (#N/A)... for the life of me I can't figure out how to avoid this.

I've tried the following two goes at this... both produce the same result as they are both similar routines. Also, as an FYI, the code in it's current form produces an invalid data type error when it hit's the aforementioned entries. To get around this, I wrapped the IF statement in an "On Error GoTo Next/GoTo 0." That of course forces it to ignore the error and therefore copy the undesired rows.

Private Sub CopySearchedData(ByVal Column As String, ByVal Criteria1 As String, ByVal Destination As String, ByVal Exclude As Boolean)

Dim i: i = 0
Dim j: j = Worksheets(Destination).Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To LastRow


If (InStr(1, Worksheets(MainSheet).Range(Column + CStr(i)).Value, Criteria1) > 0 And Exclude = False) Then


    j = j + 1
    
    Worksheets(MainSheet).Rows(i).Copy
    Worksheets(Destination).Rows(j).PasteSpecial xlValues
    Worksheets(Destination).Rows(j).PasteSpecial xlFormats
    
ElseIf (Worksheets(MainSheet).Range(Column + CStr(i)).Value <> Criteria1 And Exclude = True) Then


    j = j + 1
    
    Worksheets(MainSheet).Rows(i).Copy
    Worksheets(Destination).Rows(j).PasteSpecial xlValues
    Worksheets(Desgination).Rows(j).PasteSpecial xlFormats
    
End If


Next


End Sub

Private Sub SearchAndExtract(ByVal Column1 As String, ByVal Criteria1 As String, ByVal Destination As String, Optional ByVal Column2 As String, Optional ByVal Criteria2 As Integer)

Dim i As Integer: i = 0
Dim j As Integer: j = Worksheets(Destination).Range("A" & Rows.Count).End(xlUp).Row


LastRow = Worksheets(MainSheet).Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To LastRow


Worksheets(MainSheet).Select


If Cells(i, ReturnColumnLetter2(Column1, MainSheet)) = Criteria1 Then
        
        j = j + 1
        
        Worksheets(MainSheet).Rows(i).Copy
        Worksheets(Destination).Rows(j).PasteSpecial xlValues
        Worksheets(Destination).Rows(j).PasteSpecial xlFormats
    
    End If


Next


End Sub

Also, here's the called function to return the searched column letter, if it's helpful:

Private Function ReturnColumnLetter2(ByVal ColumnName As String, ByVal SheetName As String) As String' References:
' Dependents:


' ~~> Tests a string (ColumnName) against existing headers


Dim ColumnNumber As Integer


ColumnNumber = WorksheetFunction.Match(ColumnName, Sheets(SheetName).Rows(1), 0)


ReturnColumnLetter2 = Split(Cells(1, ColumnNumber).Address, "$")(1)


End Function

 

[AlphaFrog]

Instead of wrapping the If statement in an OnError Resume Next, wrap it in another If that tests is the cell value is a formula error.

If Not IsError(Worksheets(MainSheet).Range(Column + CStr(i)).Value) Then

Alternatively, instead of looping through each row and testing each cell in a column, you could autofilter the data set and copy all the filtered rows.

 

[idlewyld89]

Appreciate the suggestion, for the first round of sorting, this will work much better than my idea above. I'll still have to go back and fine-tune some selections with a line-by-line test, but on far fewer lines!!!

Question: Can AutoFilter parameters be expressed as variables? I've been trying to push the "Criteria1" parameter as a user response from a InputBox, but it seems to not like it. Probably just have a comma or period off, but at least I'll know if I'm on the right track or not!

 

[AlphaFrog]

Question: Can AutoFilter parameters be expressed as variables?

Yes