ExcelBanter - View Single Post

Seiya

Hi, Kris

assumed:

Sheet1: you have Comapny in col.A
Sheet2: you have Person in charge in Col.A and Company in Col.B
and the company names in each sheet MUST be identical.
if you run the code with the data as above, it should work.

Code:

Sub test()
Dim r As Range, txt, ws1 As Worksheet, ws2 As Worksheet
Dim LookUpCell As Range, x
Set ws1 = Sheets("sheet1"): Set ws2 = Sheets("sheet2")
With ws2
    For Each r In .Range("b1", .Range("b65536").End(xlUp))
        If Not IsEmpty(r) Then
            If InStr(r, ";") = 0 Then
                Set LookUpCell = ws1.Range("a:a").Find(what:=r.Value,
lookat:=xlWhole)
                If Not LookUpCell Is Nothing Then
                    LookUpCell.Offset(, 1) = r.Offset(, -1).Value
                End If
            Else
                txt = Split(Replace(r, " ", ""), ";")
                    For Each x In txt
                        Set LookUpCell = ws1.Range("a:a").Find(what:=x,
lookat:=xlWhole)
                        If Not LookUpCell Is Nothing Then
                            LookUpCell.Offset(, 1) = r.Offset(,
-1).Value
                        End If
                    Next
            End If
        End If
    Next
    Set ws1 = Nothing: Set ws2 = Nothing: Erase txt
End With
End Sub