Solved: A quite complex relation search macro (hard)

[hunsnowboard]

Hi Everyone! My problem probably is a bit complex. I have a sort of database in an excel file. In this particular problem mainly two columns are relevant. Column "B" and "C". In these columns there are unique name codes (a name followed by a three digit number; example: George011). These two columns show connections (example: column B: George011, column "C": Ronaldo009). Of course as there are many rows which means that there are many connections.
What I would like the macro to do is the following. I input one unique name and the macro will search for all of the connections related to this unique name and gives back as result (on a new worksheet) the connections related to this unique name and on another new worksheet give me back the connection paths which loop back to this unique name. Actually I need the macro to work not only for unique names (George011) but for partial names as well (for example George*, which means all the unique names beginnig with George).
For better comprehension I explain it more detailed and by example.
Let?s say there is a unique identifier George011. The macro should do the following:
Search for all connections of George011. Let?s say there are three Rebeca008, Ronaldo009 and Michael002. Then the macro should search for the connections of Rebeca008, Ronaldo009 and Michael002. (From this list George011 should be excluded as we already know that they are related). Then search for the connections of this list..and so on..till the 5th or 6th level. And then show me the results (if there are any) on a new worksheet of the path who has connections with George011. I would like the macro to show this path.. Something like: George011 ->Rebeca008->David23->George011. Of course the macro should work with partial names as well (for example if I input George only..then one found path could look like: George011 ->Rebeca008->Liz023->John114->George099)

In the file attached you can see more clearly what I am talking about!

Thank you in advance for your ideas and help!

[rbrhodes]

Hi,

I'll look at it...

[Bob Phillips]

Cross-posted at JMT http://puremis.net/excel/cgi-bin/yabb/YaBB.pl?num=1228857455

[lucas]

hunsnowboard,
I tried to figure out what you are trying to do and came up with a solution I think to the first part. Search column B for a name and return all instances in column B with matches in Column C.

I was a little upset to find that you had cross posted and that I may have been wasting my time.

I noticed that you only have one post here and after I checked the link I found that no one had addressed this.

Please read the info a this (http://www.excelguru.ca/node/7) link so you will understand why it is important to provide a link if you are posting in multiple forums.


Attached is your file with my thoughts on the first part of your problem if I understand it correctly.......

[mdmackillop]

Also here
http://www.mrexcel.com/forum/showthread.php?p=1771852&posted=1#post1771852

[lucas]

Well, after reading the thread att mrexcel that Malcolm links to, it seems that I did not understand the question......

good luck.

[hunsnowboard]

Hi Everyone! First of all a very big apologies for cross-posting. I did not really know that it is not allowed! Mea culpa, mea culpa, mea maxima culpa. :banghead: However I need this macro so badly, and noone helped me so far, only in this forum. So I will delete my posts from the other sites and leave only this one.

Dear Lucas! I checked your file attached and YESSSS! YES! As first part it is brilliant!!! Perhaps you need me to explain other details or you can go on with the macro further??

Sorry again for cross posting. I'll delete the other posts! Thank you for those who try to help!

[mdmackillop]

Do not delete any posts. That is worse than cross posting. Add a link to other sites where required.

[lucas]

Hi Everyone! First of all a very big apologies for cross-posting. I did not really know that it is not allowed! Mea culpa, mea culpa, mea maxima culpa. :banghead: However I need this macro so badly, and noone helped me so far, only in this forum. So I will delete my posts from the other sites and leave only this one.

Dear Lucas! I checked your file attached and YESSSS! YES! As first part it is brilliant!!! Perhaps you need me to explain other details or you can go on with the macro further??

Sorry again for cross posting. I'll delete the other posts! Thank you for those who try to help!

First of all, crossposting is not disallowed. We just want to know if others are working on it and what they have done before investing time in your project......it's just courtesy. Provide the links and all will be well.

I agree 100% with Malcolm. Do not delete threads anywhere, it is not necessary and can destroy your questions integrity everywhere.

If you can give more details here as to what you want to happen next it would help.........I certainly don't understand yet what you are trying to do.

Provide a simple example from the data with details on the example excel file. That will help us understand what you are trying to do.

[Colo]

I've just read the thread on mrexcel. To make it work for partial names, you can also use LIKE "something*" and using an array makes it more faster, I think.

http://puremis.net/excel/cgi-bin/yabb/YaBB.pl?num=1228857455
Thanks mdmackillop.

I would not agree to cross-posting, but it's a good question.

[hunsnowboard]

Hi Lucas! Thank you for the help and sorry again for cross posting. I really did not know that this is something so grave. As you and Malcolm advised I will not delete my posts, anyhow I will watch only this post.

Anyway back to the macro. Lets take the file I attached as example. Please check the following rows:
in row no. 5376 you can see George011(in column B) and Rebeca008 (in column C). This is a connection. Then see row no. 10788 where you can see Rebeca008 (in column B) and David23 (in column C). Then in row no. 10858 you can see David23 (in column B) and George011 (in column C). If we put the whole chain (all the connections) together than it would look like this: George011 ->Rebeca008->David23->George011. For better understanding or comprehension, imagine the column B as Senders and column C as Receivers. So this chain above means that George011 gave something to Rebecca008, then she gave it to David23 and then from David23 got back to George011. And this is what this macro should do. To check all the possible routes which will lead back to the same person. But as George011 has many friends, the macro should check all the possible routes. Now you can ask how deep should the search be... which means how many people can be between George011 and George011. Maximum five! No need for "deeper" search. So if George011 (besides Rebeca008) has another connection with lets say Abraham411, then the macro should search for Abraham411's connections and find out if it can find a chain which leads back to George011. The macro should not search deeper. I hope now it is clearer. If not, then please let me know and I will try to explain it another way! Thank you again a lot for your help!

[lucas]

Hello Huns, I got your pm but I'm having trouble with my internet connection currently. I'm at a friends checking email, etc.

I did take a look at your problem and it is quite complex. Hoping others will join the discussion if they have ideas........

[hunsnowboard]

Thank you Lucas! Could please someone help with some ideas?? Thank you in advance!

[mdmackillop]

A filter approach?

I've cheated by adding 000 to names without numbers as the filter did not differentiate. Maybe there is another way to handle this. Circular links should be coloured. There is a TestIt function which allows multiple runs.

[hunsnowboard]

A filter approach?

I've cheated by adding 000 to names without numbers as the filter did not differentiate. Maybe there is another way to handle this. Circular links should be coloured. There is a TestIt function which allows multiple runs.

Woooow! I really dont believe it, but you made it! Finally!!! YEEESSS! You can't believe how happy you made me now! In the coming days I will test it with my collegues and let you know about the details! As first look it seems that is working perfectly!!! THANK YOU! THANK YOU! :bow::yes:clap:

[hunsnowboard]

HI Mdmackillop! Thanks again for your help and the macro. First of all, how can the macro search only till level 4? Later we will need level 5 and 6, but for now searching till lever 4 is enough.
Second question: I have created a second sheet in your file. On the second sheet you can see the connection chain visible in the columns. I made this manually. Can the macro make something similar? I have highlighted the beginnig and the end of the chain (which is George011). I hope you understand my question! Thank you in advance and have a nice weekend!

[mdmackillop]

Try this version. To see progress of test, split the screen horizontally as below.

[mdmackillop]

Display

[hunsnowboard]

Hi Mdmackillop! You just amaze me how good you are in this thing. Congratulations, and thank you very very much!
There is only one thing that would make perfect the whole thing. Can this macro work with partial names as well?
I mean I do a search on George011 and I am interested in the results and findigs of names beginnig with George. So all the codenames beginnig with George. Like George001, George002, George003 and so on. In case of George011 an example in the file would be: George011->Rebeca008->Liz023->John114->George099
Can this be done? Thank you a lot!

[mdmackillop]

Partial names cause a problem, but the Test routine is easily modified to check all permutations

[hunsnowboard]

Thank you Mdmackillop! Thank you for your continuous help! I appreciate it a lot! You are very helpful! Thank you!

Unfortunatelly the name test is not really a solution for me, as I would be interested in the names beginnig with George. Anyway maybe the information I will provide now could give you a tip.
The codes the macro will search for will look like this: DX15445545, ZU1245574, CX1244. (In my example file I gave names such as George011 because this way was more understandable and comprehensible.) So the codes the macro searches for will look like this: 2 letters + X number of digits. For us the important would be to search for a given code like DX15445545 (like George011) and then find (and show on the Results sheet) all the chains beginnig with DX (like DX458445, DX14, DX875 are all solutions) in our example all the names beginnig with George (like George008, George057 are all solutions). It is very important that the codenames ALLWAYS begin and contain only 2 letters and then have a few digits. As I wrote previously for us would be important to search for the letters.
I hope now it is clearer for you. Anyway as I understood this request cannot be done in vba right?
Thank you a bunch!!!

[mdmackillop]

I misread your requirements for partial. This will test all George combinations for any George result.

The code is getting a bit cludgy with duplication etc. but I'm sure it can be tidied up in due course.

[mdmackillop]

Can you post some "real life" data?

[hunsnowboard]

Unfortunatelly no. I cannot bring out any data from the company. :( That is why I had to make this file with the names on my own. :(

Your latest macro works perfectly when searching names. But the way I first asked cannot be done right? I mean searching for George011 and then give as a result all of the findings beginnig with George (George011, George099 as results). This cannot be done right?

Very important question is that will your macro work with this type of codes (DX4524, GK4512454, KS4544 and so on) as well?

[mdmackillop]

The last code should work with George. With regard to DX??? etc, I can get this to work by adding a suffix eg DX4521z. The reason for this is that Filter does not distinguish shorter strings (at least I can't find a setting to do so
eg if you search DX45 and get 5 links, DX4 will find the same 5 links plus any "proper" DX4 links. The suffix prevents this error.

The addition/removal of a suffix can of course be accomplished by code.
BTW, this demonstrates why it is important to submit proper data styles/layouts in sample workbooks.

[hunsnowboard]

Hello!

I just have tried the version 5 macro. When I try to run the Test name I get a VBA error: "Run-time error '438': Object doesn't support this property or method" The problem is in row: ActiveSheet.Sort.SortFields.Clear
Am I doing something wrong?

[mdmackillop]

What version of Excel are you running?

[hunsnowboard]

Ms Excel 2003

[mdmackillop]

Can you record a macro sorting a column of data and post the code.

[hunsnowboard]

Sure, no problem!
Here it is:

Sub R?gz?t?s1()

Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="HF12z"
End Sub

If I put again selection.autofilter then it takes off the autofilter.

[mdmackillop]

Not filtering; sorting in ascending order.

[hunsnowboard]

Ohh sorry!
I made a few filter examples!

Here it is:


Sub R?gz?t?s2()

Selection.Sort Key1:=Range("B3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Sort Key1:=Range("B3"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Sort Key1:=Range("B3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Sort Key1:=Range("B3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub

[mdmackillop]

Change this routine
Sub CreateSearchList()
Columns("AA:AA").ClearContents
If Right(Range("A11"), 1) <> "*" Then Range("A11") = Range("A11") & "*"

Columns(2).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("A10:A11"), CopyToRange:=Range("AA1"), Unique:=True
Set DataRng = Range(Cells(2, 27), Cells(2, 27).End(xlDown))


DataRng.Sort Key1:=DataRng(1), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

[hunsnowboard]

Hi! Thank you, thank you for helping.

The code you provided works. There seems to be a problem. In the attached file I have added a few extra rows (a chain) This chain is:
HF12z- BD38z - IG47z - HF933z. If I make a search for HF12z using the Run Filter search the macro will find only one chain, namely: HF12z - KJ58z - GH21z - HF12z. Can't this kind of search (Run Filter) find both chains? The other problem is that if I run a Test Name search the macro will find only one chain for HF12z, namely: HF12z- BD38z - IG47z - HF933z. It cannot find: HF12z - KJ58z - GH21z - HF12z chain. However if I delete the previous chain (HF12z- BD38z - IG47z - HF933z) then it will find this chain: HF12z - KJ58z - GH21z - HF12z. It seems like the macro is not able to find two chains. I have attached the file, so you can test it as well.

[mdmackillop]

File not attached

[hunsnowboard]

Sorry. I edited and attached it!

[hunsnowboard]

Good morning! Did you get the file? Do you understand my problem described in the post above? My english is not very good...:(

[mdmackillop]

updated

[hunsnowboard]

Thank you Mdmackillop! It is working! In order to get it function in the office as well I have a few questions.

1. The Run Filter search is not able to find the all the chains beginnig with the same two letters, am I right? I mean, if we search for HF12z (this type of search) will be able to find only the chains ending with HF12z, am I right? It cannot find the chains beginnig with HF (such as in our example: HF993z) as this would be the optimal solution for us, am I right?

2. In the office the file contains many worksheets. If I insert these two worksheets ("Munka1" and "Results") the macro will work, right? I do not have to change anything in the macro right? Anyway can I rename the "Munka1" worksheet?

3. Basically if I take copy the codenames of the original file, and paste it in the "Munka1" worksheet and (make a macro to) add a "z" at the of the codenames then the macro will work like it is working now, am I right?

Thank you!

[mdmackillop]

If you look at the Test Name results you will see that Partial results are found. Enter the string to be found in A14 and run the following for a Partial search.

Sub TestPartial()
Cells(2, 7) = Range("A14")
MacroPartial
End Sub

Re Points 2 & 3, I'll need to get back to you. No more time today.

[hunsnowboard]

Thank you for your help. If you can please try to reply today evening to my two points, as I'd like to test the macro tomorrow at the office! If you can't no problem! Thank you a lot for your efforts and help!

[mdmackillop]

I would add the Munka worksheet to your workbook. Its name does not matter. The "Results" name is used in the code, and would need to exist. You could add code to copy data from other sheets to Munka for processing, adding the "z" as you do so. At least that is how I would probably approach it.

[hunsnowboard]

Thank you for the reply. Tomorrow I'll try to make it work in the office. My collegues probably will be amazed about this macro. I'll let you know about the outcome! Thank you very much for your help!

[hunsnowboard]

Hello Mdmackillop! Thank you a lot for your help! Just wanted to let you know that the code you made is working brilliantly! Thank you a lot for your help!

[hunsnowboard]

Hi Mdmackillop! Here is the attached file! Thank you!

[mdmackillop]

It is basically a simple filter using the result of each step as the criteria for the next loop. At each step, the results are checked for the original criteria, and if found, the path back to the source is highlighted.

Sub Macro14()
Dim CR As Range
Dim CtR As Range
Dim Rslt As Range
Dim Col As Long
Dim Levels As Long
Levels = Range("A2")
'Set inital values and clear old data
Clr = 5
Col = 7
i = -1
Cells(1, 7) = "UserID-1"
Columns("H:U").ClearContents
Columns("H:U").Interior.ColorIndex = xlNone


Do
i = i + 1
'set CR to list of tems to be looked for
Set CR = Range(Cells(1, Col), Cells(Rows.Count, Col).End(xlUp))
'set target range for filtered data to next 2 columns - row 1
Set CtR = CR(1).Offset(, 1).Resize(, 2)
'CtR.Select
'Filter columns B:C to new location
Columns("B:C").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=CR, CopyToRange:=CtR
'Copy/create heading
CtR.FillRight
CR(1) = "Level " & i
CR(1).Offset(, 1).ClearContents
'Ser Reslt to Reults range
Set Rslt = Range(CR(1).Offset(, 2), CR(1).Offset(, 2).End(xlDown))
'Rslt.Select
'Exit if no reults found
If Rslt.Cells.Count = Cells.Rows.Count Then
'MsgBox "No more links"
Exit Sub
End If

'Highlight if match to original data
MarkIfFound Cells(2, 7), Rslt
Col = Col + 2
If Col > Levels * 2 + 5 Then
CR(1).Offset(, 2) = "Level " & i + 1
'Range("G2").Select
Exit Sub
End If
Loop
End Sub
Sub MarkIfFound(txt As String, Rng As Range)
Dim Lev As String
Dim Col As Long
With Rng
'.Select
Set c = .Find(txt)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Clr = Clr + 1
'Highlight cell with first colour
c.Interior.ColorIndex = Clr
'Write Results to Sheet 2
Lev = Cells(1, c.Column)
Col = Right(Cells(1, c.Column - 2), 1) + 2
With Sheets("Results")
Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1 'Results row
.Cells(Rw, 1) = txt
.Cells(Rw, Col) = c
End With
c.Value = c & "x"
Cells(Rows.Count, 4).End(xlUp).Offset(1) = txt
'Work back to source
TracePath c, txt, Clr
Set c = .FindNext(c)
On Error Resume Next
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub

Sub TracePath(Fnd As Range, txt As String, cl As Long)
'Follow back to source in selected colour
Dim g As Range
Dim Precd As String
Precd = Fnd.Offset(, -1)
Set g = Columns(Fnd.Column - 2).Find(Precd)
g.Interior.ColorIndex = cl
'Write Results to Sheet 2
Lev = Cells(1, g.Column)
Col = Right(Lev, 1) + 1
With Sheets("Results")
.Cells(Rw, Col) = g
End With
'#########################
If g.Column < 10 Then Exit Sub
TracePath g, Precd, cl
End Sub