View Single Post
 
Old 05-28-2018, 08:13 AM
NoSparks NoSparks is offline Windows 7 64bit Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 842
NoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of light
Default

Using VBA with data as-is I find 320 name matches.
Cleaning up different space characters and double spaces in column A "Full List" gets 573 matches.

Code:
Option Explicit


Sub get_ID()

    Dim rng As Range, cel As Range, fndRng As Range
    Dim strName As String, arrName As Variant
    
    'Call CleanUpNames

Application.ScreenUpdating = False
    
With Sheets("Schedule Alerts")
    Set rng = .Range(.Cells(3, 2), .Cells(Rows.Count, 2).End(xlUp))
End With

For Each cel In rng
    arrName = Split(cel, ",")
    strName = Trim(arrName(1)) & " " & Trim(arrName(0))
    
    With Sheets("Full List").Range("A:A")
            Set fndRng = .Find(What:=strName & "*", _
                               LookIn:=xlValues, _
                               LookAt:=xlPart, _
                               SearchOrder:=xlByRows, _
                               SearchDirection:=xlNext, _
                               MatchCase:=False)
            If Not fndRng Is Nothing Then
                cel.Offset(, 9).Value = fndRng.Offset(, 1).Value
            End If
    End With
Next cel

'Range("N3").Value = WorksheetFunction.CountA(Range("K3:K1820"))

Application.ScreenUpdating = True

End Sub


Private Sub CleanUpNames()
    
    Dim lr As Long, rng As Range, cel As Range
    
Application.ScreenUpdating = False

With Sheets("Full List")
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = .Range("A2:A" & lr)
End With

For Each cel In rng
    cel.Value = WorksheetFunction.Trim(Replace(cel.Value, Chr(160), Chr(32)))
Next cel

Application.ScreenUpdating = True

End Sub
Reply With Quote