CODEWITHSUNDEEP
vbaexcel
udz
udz

Reputation: 17

VBA Excel VLookup

I have a first worksheet with the following set of values

Column A
**Sender Name**
SAAD MAJID S R AL SAAD
IBRAHIM BIN SABTU ATAU ZULKIFLEE BIN ABDUL RAHMAN
PUSPA LAL JONES
RENJA BAHADUR NEPAL
RENJA BAHADUR RANGER
RENJA BAHADUR HAMAL
PARSHU RAM KARKI

A second worksheet has the below values

Column A
**Sir Names**
Jones
Ranger
Brown
Hamal
Karki

I want to use VLookup in VBA to find and delete the lines of data in the first worksheet if the surnames mentioned in second sheet appear as a part of the full name.

Essentially it'll leave following records.

SAAD MAJID S R AL SAAD
IBRAHIM BIN SABTU ATAU ZULKIFLEE BIN ABDUL RAHMAN
RENJA BAHADUR NEPAL

I've written following code in VBA but I am getting an error. 

Dim NameArray() As String
Dim result

Sub vlookupcode()
'Find last row with data in Column A
lastrow = Range("A" & Rows.Count).End(xlUp).row
'Start at bottom and delete rows with errors
For myNA = lastrow To 1 Step -1
    'If IsError(Cells(myNA, 1)) Then

  tmp = Cells(myNA, 1).Value
  'MsgBox tmp
  NameArray() = Split(tmp, " ")
  For i = LBound(NameArray) To UBound(NameArray)

    'MsgBox i & " " & NameArray(i)

    result = Application.VLookup(NameArray(i), Sheet2.Range("A2:A6"), 1, False)

    If IsError(result) Then
        MsgBox "Error"
        Cells(myNA, 1).EntireRow.Delete
    End If
  Next

 Next
End Sub

Could you please help me solve this.

Upvotes: 0

Views: 102

Answers (2)

user3819867
user3819867

Reputation: 1118

Sub vlookupcode()
'Find last row with data in Column A
lastrow = Range("A" & Rows.Count).End(xlUp).Row
'the range to which you want to compare
Dim comparerng As Range
    Set comparerng = Sheet2.Range("A2:A6")
'the boolean that stores whether there were occurences
Dim result As Boolean

'Start at bottom and delete rows with no matching values in the other set
For myNA = lastrow To 1 Step -1

  tmp = Cells(myNA, 1).Value
  'there are no occurrences until found
  result = True

    For Each cell In comparerng.Cells
        If LCase(tmp) Like "*" & LCase(cell.Value2) & "*" Then result = False 'if there's a match then set the boolean to false
    Next cell

    'if there was no value found then delete
    If result Then
        ert = MsgBox("Do you want to delete " & tmp & "?", vbOKCancel) 'if you prompt then why not ask for feedback?
        If ert = vbOK Then Cells(myNA, 1).EntireRow.Delete
    End If
Next
End Sub

Upvotes: 0

user4039065
user4039065

Reputation:

The most efficient lookup for a partial match would likely be through the worksheet's own MATCH function with wildcards.

Sub del_surname()
    Dim rw As Long, ws1 As Worksheet

    Set ws1 = Worksheets("Sheet1")

    With Worksheets("Sheet2")
        For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            If Not IsError(Application.Match(Chr(42) & .Cells(rw, 1) & Chr(42), ws1.Columns(1), 0)) Then
                ws1.Rows(Application.Match(Chr(42) & .Cells(rw, 1) & Chr(42), ws1.Columns(1), 0)).EntireRow.Delete
            End If
        Next rw
    End With

End Sub

The match function will retrieve the row number where the wildcarded lookup finds its target. If the surname was always the last word in the string(s) then Chr(42) & .Cells(rw, 1) & Chr(42) could be altered to Chr(42) & .Cells(rw, 1).

If more than a single potential match is a possibility, either a repeating loop or an alternate method with the Range.Find method and Range.FindNext method would be necessary.

Upvotes: 1

Related Questions