idlewyld89
New Member
- Joined
- Jun 10, 2018
- Messages
- 23
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.
Also, here's the called function to return the searched column letter, if it's helpful:
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.
Code:
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
Code:
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:
Code:
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