Change MAXLENGTH to the maximum string length (number of characters) you
want in a cell. It will not split a name (but could slightly exceed
MAXLENGTH). It assumes all cells to the right are available to place the
data.

Sub test()
Const MAXLENGTH as Long = 5000
Dim r As Range, txt, ws1 As Worksheet, ws2 As Worksheet
Dim LookUpCell As Range, x
Dim faddr as String, rng as Range, r1 as Range
Set ws1 = Sheets("FireWall Rules"): Set ws2 = Sheets("LDAP")
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
fAddr = LookupCell.Address
do
set rng = LookUpCell.offset(,1)
do while len(rng) MAXLENGTH
set rng = rng.offset(0,1)
Loop
rng = rng & _
r.Offset(, -1).Value & ";"
Set LookUpCell = ws1.Range("a:a").FindNext( _
LookUpCell)
Loop While LookupCell.Address < fAddr
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
fAddr = LookUpCell.Address
Do

set rng = LookUpCell.offset(,1)
do while len(rng) MAXLENGTH
set rng = rng.offset(0,1)
Loop
rng = rng & _
r.Offset(, -1).Value & ";"
Set LookUpCell = ws1.Range("a:a").FindNext( _
LookUpCell)
Loop While LookupCell.Address < fAddr
End If
Next
End If
End If
Next
End With

With ws1
For Each r In .Range("b1", .Range("b65536").End(xlUp))
set r1 = r
do while len(trim(r1)) < 0
if Right(r1,1) = ";" then
r = Left(r1,len(r1)-1)
end if
set r1 = r1.offset(0,1)
Loop
Next
Set ws1 = Nothing: Set ws2 = Nothing: Erase txt
End With
End Sub

--
Regards,
Tom Ogilvy

"Tom Ogilvy" wrote in message
...
If that code does what you want and you just want to keep searching, then
this should work:

Sub test()
Dim r As Range, txt, ws1 As Worksheet, ws2 As Worksheet
Dim LookUpCell As Range, x
Set ws1 = Sheets("FireWall Rules"): Set ws2 = Sheets("LDAP")
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
fAddr = LookupCell.Address
do
LookUpCell.Offset(, 1) = LookUpCell.Offset(,1) & _
r.Offset(, -1).Value & ";"
Set LookUpCell = ws1.Range("a:a").FindNext( _
LookUpCell)
Loop While LookupCell.Address < fAddr
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
fAddr = LookUpCell.Address
Do
LookUpCell.Offset(, 1) =
LookUpCell.Offset(,1)
& _
r.Offset(, -1).Value & ";"
Set LookUpCell = ws1.Range("a:a").FindNext( _
LookUpCell)
Loop While LookupCell.Address < fAddr
End If
Next
End If
End If
Next
With ws1
For Each r In .Range("b1", .Range("b65536").End(xlUp))
if Right(r,1) = ";" then
r = Left(r,len(r)-1)
end if
Next
Set ws1 = Nothing: Set ws2 = Nothing: Erase txt
End With
End Sub

--
Regards,
Tom Ogilvy


"Chris" wrote in message
om...
Just like i said in the earlier thread, i changed the plans a little
bit.
Earlier i would look in sheet1 for a employee name and search for the
same name in sheet2. If he found that name he should copy the company
name to sheet1. And some employee's are working at two or three (up to
15) company's, and the company names are seperated with a ';'.

But the plan is changed to....
I made a sub who copies all the company names to sheet1 (The sheet
numbers are a little shuffled also so maybe they are different with
the first plan) without dupes.
He have to look now at the company name and look for that name in
sheet 2 and copy the employee name to an array or somthing. But there
are several rows with the same company. Because every employee has his
own row.
Than plan is if he has all the employee names who are in a certain
company, he have to match that names with an administrative sheet (the
third sheet)to look if the admistation is uptodate.
My problem now is that the code i get earlier (who is above also)
looks for the company name if he found it he copy's the employee name.
If he found one he stop searching. He have to look further down to the
sheet (+/- 12000 rows) and copy all the employee names who has that
certain company name in there row.
I dont know exactly if this is a smart plan cause maybe i have a
problem later when he have to macht the employee names with the third
sheet.
But for now he has to match the company names and get all the employee
names. There are about 40 company's and 12000 employees. Can he make a
array whith the employee names and the company names matched and the
lookup that names in the third sheet.

I hope i'am clear now, if not i'm sorry and just ignore this message
:).