Search Names problem

[JohnPoole]

Hi all, I am trying to write a macro which will look at a search term entered into cell C1, then if there is a defined Name in the search range (AM1:DA5000) which matches then then name will be outputted to listbox 1.

eg if cell c1 = Out
then listbox 1 would return the following names from the above range:
Out1
Out2
Outer
Siderout
Outsider

I have the following code, which will only return the first instance it finds:

<font face=Courier New><SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Sub</SPAN> findnames()<br><br><SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> Range, rng<br><SPAN style="color:#00007F">Dim</SPAN> n <SPAN style="color:#00007F">As</SPAN> Name<br><br>ActiveSheet.ListBox1.Clear<br>mystr = [c1].Value<br>**** <br>****<SPAN style="color:#00007F">Set</SPAN> rng = Range("AM1:DA5000")<br>************<SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> rng<br>****************<SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> n <SPAN style="color:#00007F">In</SPAN> ActiveWorkbook.Names<br>********************<SPAN style="color:#00007F">If</SPAN> InStr(c, mystr) > 0 <SPAN style="color:#00007F">Then</SPAN><br>****************<br>********************ActiveSheet.ListBox1.AddItem c<br>****************** <br>************************<br>******************** <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>****************<SPAN style="color:#00007F">Next</SPAN> n<br>************<SPAN style="color:#00007F">Next</SPAN> c<br>********<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>


Can anyone advise what I need to change here?

 

[JohnPoole]

Just bumping this....

 

[Richard Schollar]

Hi John

You can use the Find method for this - it will be much fatser than iterating each cell:

Public Sub findnames()
Dim c As Range, rng As Range
Dim n As Name, strFirstAdd As String
ActiveSheet.ListBox1.Clear
mystr = [c1].Value
 
Set rng = Range("AM1:DA5000")
With rng
  Set c = .Find(mystr,LookAt:=xlPart,Lookin:=xlValues)
  If Not c Is Nothing Then
    strFirstAdd = c.Address
    Do
      ActiveSheet.ListBox1.AddItem c.Value
      Set c = .FindNext(c)
    Loop While c.Address <> strFirstAdd
  End If
End With

End Sub

 

[JohnPoole]

Hi, thanks for the reply. I've given this a go and found a slight problem. Rather than returning just the defined names, it is returning every cell in the range which matches what is in C1. Looking at the code you provided, it searches for a matching string and returns it to the listbox, but doesnt check to see if it is a defind name.

I have tried to modify the following line;
Set c = .Find(mystr, LookAt:=xlPart, LookIn:=ActiveWorkbook.Names)
to look in activeworkbook.names but this resulted in an error.

Any ideas?

 

[Richard Schollar]

Sorry John, I had completely overlooked that you wanted to incorporate names into the plan. It can be modified and i will do so and post back - sorry

 

[Richard Schollar]

Hi John

Try this- let me know if it works for you:

Public Sub findnames()
Dim c As Range, rng As Range, nm As Name
Dim n As Name, strFirstAdd As String


ActiveSheet.ListBox1.Clear
mystr = [c1].Value

Set rng = Range("AM1:DA5000")
With rng
  Set c = .Find(mystr, LookAt:=xlPart, LookIn:=xlValues)
  If Not c Is Nothing Then
    strFirstAdd = c.Address
    Do
        On Error Resume Next
        For Each nm In ThisWorkbook.Names
            If Not Application.Intersect(c, Range(nm.Name)) Is Nothing Then .ListBox1.AddItem c.Value
        Next nm
      Set c = .FindNext(c)
    Loop While c.Address <> strFirstAdd
  End If
End With

End Sub

 

[JohnPoole]

Hi Richard, unfortunatley that doesnt seem to work, no entries are returned at all, even if the search term in C1 is an exact match of a name held in the search range

 

[Richard Schollar]

John, I feel embarrassed: I have re-read your original question and have to admit I just completely misunderstood what you were trying to achieve. I hope the following is closer:

Public Sub findnames()
Dim c As Range, rng As Range
Dim n As Name, strFirstAdd As String
ActiveSheet.ListBox1.Clear
mystr = [c1].Value
 
Set rng = Range("AM1:DA5000")

For Each n In ThisWorkbook.Names
  On Error Resume Next
  Set c = Range(n.Name)
  On Error Goto 0
  If Not c Is Nothing Then
    If Not Intersect(c, rng) Is Nothing Then Activesheet.ListBox1.AddItem n.Name
  End If
  Set c = Nothing
Next n
End Sub

 

[JohnPoole]

The following line
If Not Intersect(c, rng) Is Nothing Then

produces an error:
method 'intersect' of object '_global' failed.

 

[Richard Schollar]

Presumably because the range is on another sheet. Account for that with:

Public Sub findnames()
Dim c As Range, rng As Range
Dim n As Name, strFirstAdd As String
ActiveSheet.ListBox1.Clear
mystr = [c1].Value
 
Set rng = Range("AM1:DA5000")
 
For Each n In ThisWorkbook.Names
  On Error Resume Next
  Set c = Range(n.Name)
  On Error Goto 0
  If Not c Is Nothing Then
    If c.Parent.Name = rng.Parent.Name Then
      If Not Intersect(c, rng) Is Nothing Then Activesheet.ListBox1.AddItem n.Name
    End If
  End If
  Set c = Nothing
Next n
End Sub