CODEWITHSUNDEEP
vbaexcelvlookup
New2VBA
New2VBA

Reputation: 347

VLOOKUP to Delete Values That Don't Match Referenced Values

I'm trying to take all of the values held within SourceSheet.Range("C2:C" & LastRowSource) and cross reference them with all of the values held within ReferenceSheet.Range("F7:F" & LastRowReference). If they do not exist within that range, then I want to delete the entire row that holds that value in the C column. Problems:
1. It returns the error "Unable to get the Vlookup property of the WorksheetFunction Class." 2. Even without this error, I'm not 100% sure I have the code written right or efficiently. Thanks!

 Sub FiltrarCalypso()
 Dim Sourcebook As Workbook
 Dim SourceSheet As Worksheet
 Dim Referencebook As Workbook
 Dim ReferenceSheet As Worksheet
 Dim LastRowSource As Long
 Dim LastRowReference As Long
 Dim FindString As String

 Set Sourcebook = Workbooks("Nemail")
 Set SourceSheet = Sourcebook.Worksheets("QP")
 Set Referencebook = Workbooks("Op")
 Set ReferenceSheet = Referencebook.Worksheets("OP")
 LastRowSource = SourceSheet.Cells(Rows.Count, "C").End(xlUp).Row
 LastRowReference = ReferenceSheet.Cells(Rows.Count, "A").End(xlUp).Row

 For i = 2 To LastRowSource
     FindString = Application.WorksheetFunction.VLookup(SourceSheet.Range("C" & i),     ReferenceSheet.Range("F7:F" & LastRowReference), 1, False)
If FindString <> 1 Then
SourceSheet.Range("A" & i & ":z" & i).Delete
Else: End if


 Next i

 End Sub

Upvotes: 0

Views: 1263

Answers (1)

Kyle
Kyle

Reputation: 2545

This looks close. First issue, you should always loop in reverse when deleting rows/columns. Next, I prefer to use a .Find() rather than a worksheet function. This loops through and tries to find the value of Range("C" & i) in column F of your reference sheet. It does this by setting the the variable "FindString" (which I changed to a range) to the Range.Find() (which returns a range). If it doesn't find the value, "FindString" will be nothing, the If statement will evaluate to true and the entire row will be deleted from your source sheet.

 Sub FiltrarCalypso()
 Dim Sourcebook As Workbook
 Dim SourceSheet As Worksheet
 Dim Referencebook As Workbook
 Dim ReferenceSheet As Worksheet
 Dim LastRowSource As Long
 Dim LastRowReference As Long
 Dim FindString As Range

 Application.ScreenUpdating = False

 Set Sourcebook = Workbooks("Nemail")
 Set SourceSheet = Sourcebook.Worksheets("QP")
 Set Referencebook = Workbooks("Op")
 Set ReferenceSheet = Referencebook.Worksheets("OP")
 LastRowSource = SourceSheet.Cells(Rows.Count, "C").End(xlUp).Row
 LastRowReference = ReferenceSheet.Cells(Rows.Count, "A").End(xlUp).Row

 For i = LastRowSource to 2 Step -1 'Step -1 tells this to loop in reverse
     On Error Resume Next
     Set FindString = ReferenceSheet.Range("F:F").Find (SourceSheet.Range("C" & i)

If FindString Is Nothing Then
SourceSheet.Range("A" & i).EntireRow.Delete
End if

Next i

End Sub

EDIT:

I believe the below should be quicker. It write the values of each cell in column C to the first "column" in a 2-D array (SourceArray), and writes the row index of that cell to the second "column" of SourceArray. It then write all the values from column F in ReferenceSheet to a 1-D array called ReferenceArray. It then loops through SourceArray() in reverse (since we wrote the array going forward, we want to loop backward so we delete the highest number row first) and compares it to each value in ReferenceArray(). If the value is found, a flag (flg) is set to true, and our inner loop is exited. If flg = True, then we do nothing (the value was found), else, we delete the row associated with the value in SourceArray(i,1).

Please mark this answered if this does in fact answer your question!

 Sub FiltrarCalypso()
 Dim Sourcebook As Workbook
 Dim SourceSheet As Worksheet
 Dim Referencebook As Workbook
 Dim ReferenceSheet As Worksheet
 Dim LastRowSource As Long
 Dim LastRowReference As Long
 Dim FindString, C As Range
 Dim SourceArray() as String
 Dim ReferenceArray() as String
 Dim RowArray()
 Dim i, j as integer
 Dim flg as Boolean

 Set Sourcebook = Workbooks("Nemail")
 Set SourceSheet = Sourcebook.Worksheets("QP")
 Set Referencebook = Workbooks("Op")
 Set ReferenceSheet = Referencebook.Worksheets("OP")
 LastRowSource = SourceSheet.Cells(Rows.Count, "C").End(xlUp).Row
 LastRowReference = ReferenceSheet.Cells(Rows.Count, "A").End(xlUp).Row

 Redim SourceArray(0 to LastRowReference - 2,0 to 1)
 Redim ReferenceArray(0 to LastRowSource - 7)

 For i = 0 to Ubound(SourceArray())
   SourceArray(i,0) = SourceSheet.Cells(i+2,3)
   SourceArray(i,1) = SourceSheet.Cells(i+2,3).Row
 Next i

 For i = 0 to Ubound(ReferenceArray())
   ReferenceArray(i,0) = ReferenceSheet.Cells(i+7,6)
 Next i

 For i = Ubound(SourceArray()) to 0 Step -1
   flg = False
   For j = 0 to  Ubound(ReferenceArray())
      If SourceArray(i,0) =  ReferenceArray(i) Then
         flg = True
         Exit For
      End if
   Next j
   If flg = False Then
    SourceSheet.Range("A" & SourceArray(i,1)).EntireRow.Delete
   End if
Next i     



End Sub

Upvotes: 1

Related Questions