Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Match and Copy to array
I have a question about som things.
Earlier i get this script, and it works fine. 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 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 This script looks in Column A of sheet1 for a certain company name, search for the same company name in column B of sheet2, and copy the column A value of the same row to sheet1 Column B. It works perfect. Here a little example of sheet 2 A B C D E 1 employee Company 2 Steve Sony 3 John Philips 4 Chris Sony 5 Steven Sony 6 Rutger Philips As you can see there are more employees at one company (company names are also represented in column A of sheet but without dupes). I want the empleyees in array, cause these have to be matched with my third sheet.... I don't know how to do this any suggestions? |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Match and Copy to array
How does it work perfect if it doesn't do what you want?
What does this do that doesn't answer what you want to do. As I recall, I provided code that does what you ask, but you chose to ignore it. Perhaps you should look back at your original post and say why that doesn't work. -- Regards, Tom Ogilvy "Chris" wrote in message om... I have a question about som things. Earlier i get this script, and it works fine. 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 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 This script looks in Column A of sheet1 for a certain company name, search for the same company name in column B of sheet2, and copy the column A value of the same row to sheet1 Column B. It works perfect. Here a little example of sheet 2 A B C D E 1 employee Company 2 Steve Sony 3 John Philips 4 Chris Sony 5 Steven Sony 6 Rutger Philips As you can see there are more employees at one company (company names are also represented in column A of sheet but without dupes). I want the empleyees in array, cause these have to be matched with my third sheet.... I don't know how to do this any suggestions? |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Match and Copy to array
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 :). |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Match and Copy to array
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 :). |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Match and Copy to array
Thanks for you help Tom, it does exactly what i ment.
Only he said that fAddr whasn't defined so i had made a: Dim fAddr and i have placed een extra extra: End With, at the end. maybe this isnt the way you have made it so please tell me if i did somthing wrong. Thanks again Chris |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Match and Copy to array
As i said before the code i just get from Tom is working fine, till
now.. I discovered that in one company not all the employee names can fit to one cell. Verry logical because there are +/- 6000 of them. I've searched in som other topics but i couldn't find a code that begin to fill a cell to the right when the first one is full. Offcourse he may not break a employee name in two parts. Is there a simple solution code for this? Or is it just not possible. btw i don't get an error, he just stops with looking for other employee names (i think), so maybe it is not even related to the cell capicity..... Hope you can give me som advice. Chris |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Match and Copy to array
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 :). |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
MATCH() on a 2D array? | Excel Discussion (Misc queries) | |||
Match using array of column and row references to match with | Excel Worksheet Functions | |||
index match array function-returning only first match, need last. | Excel Worksheet Functions | |||
Match as well as does not match array function | Excel Discussion (Misc queries) | |||
Copy Array pointer rather than entire array | Excel Programming |