Excel VBA Find a value within a cell from an array and return value to new column-CodePudding

Good day, I am a newbie to VBA. I have not included the code I have tried, because nothing has even come close.

I have a Data range of about 10,000 that contains the building, department, user name and possibly other information. This information is in column B. The names are not in the same location of each cell and they can be any case and can contain up to 4 words.

I have a Named Range (Full Name) of about 14,000 names in a separate workbook named database.

I need to see if the names show up in the data range list and if so populate column C with the name.

Thanks in advance for any assistance.

Example code:

Sub Full_Name()
    
    Dim iWs As Worksheet, iFn As Variant, lastrow As Long, iDB As Worksheet
    
    iFn = Range("'[Shadow Datafie Database.xlsx]EMCP'!Full_Name").Value
    Set iWs = ActiveWorkbook.Worksheets("EMCP")
    lastrow = iWs.UsedRange.Rows.Count   1
    
    For i = 2 To lastrow
        If InStr(iWs.Cells(i, 2), iFn) > 0 Then
            iWs.Cells(i, 3) = iFn
        End If
    Next
    
End Sub

CodePudding user response：

This code may work for you:

It assumes your list of names is in an Excel table called Table1.

Sub FindName()

    'Open the csv file containing your information - building, department, etc.
    Dim wrkBkSrc As Workbook
    Set wrkBkSrc = Workbooks.Open("<path to your file>\Numplan(11).csv")

    'A csv file will only contain a single sheet, so can reference it by sheet position - first and only.
    With wrkBkSrc.Worksheets(1)
        Dim DataRange As Range
        Set DataRange = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
    End With
    
'    *** OLD CODE ***
'    With ThisWorkbook.Worksheets("Sheet1")
'        Dim DataRange As Range
'        Set DataRange = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
'    End With
    
    'Open the database file and set reference to it.
    Dim wrkBk As Workbook
    Set wrkBk = Workbooks.Open("<path to your file>\Database.xlsx")
    
    'Set reference to the names table.
    'Note: This is an Excel table, not an Excel range.
    '      Press Ctrl T to turn range into a table.
    Dim NameTable As ListObject
    Set NameTable = wrkBk.Worksheets("Database").ListObjects("Table1")
    
    'Only continue if there's data in the table.
    If Not NameTable.DataBodyRange Is Nothing Then
        Dim NameItm As Range
        Dim FoundItm As Range
        For Each NameItm In NameTable.DataBodyRange
            'Find the name within the DataRange.
            Set FoundItm = DataRange.Find( _
                What:=NameItm, _
                After:=DataRange.Cells(1, 1), _
                LookIn:=xlValues, _
                LookAt:=xlPart, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
            
            'If it's found place the name in the next column along.
            If Not FoundItm Is Nothing Then
                FoundItm.Offset(, 1) = NameItm
            End If
        Next NameItm
    End If
    
End Sub