0

I am trying to write a macro that searches a whole sheet for a value and then stores the values and locations of ALL hits for that value throughout the sheet. I will do something with the locations and values later, but I need to get this bit working first.

Originally, I used the Range.Find function with iteration and noticed that I was returning the same value. I then tried to have the range being searched change each time a value was found. I would take the address of the previously found value and make it the lower bound of the range.

This worked, to a point, but I ended up getting an infinite loop at the end. The end condition for my loop was when the Range.Find found nothing (since the size of the sheet is always changing and I don't know what the real upper limits will be). What happened was the Range.Find would get stuck on the last value and refuse to move from that spot, regardless of the change I made in the range.

My most recent attempt to deal with this was to also change the After:= input to see if that would force the program to move on. It ended up wrecking the process I already had and now I get stuck in an infinite loop with the first value. So, naturally, I just took that part out hoping to make it work again. No luck.

Here's the code: [code]

Sub SearchLibrary()
'
' SearchLibrary Macro
' Searches MC library for inputed value and returns all related inforamtion 
in Search sheet
'
' Keyboard Shortcut: Ctrl+s
'

'Search code to find all matching values and corresponding headers

' Define variables
Dim searchn As Integer ' The value input for the search
If IsNumeric(Sheets("Search").Range("C2")) Then
   searchn = Sheets("Search").Range("C2").Value
End If

Dim i As Integer ' Simple counter for loops (column number)
i = 0
Dim j As Integer 'Simple counter for loops (row number)
Dim Data As Worksheet ' Define the search area as all of the sheet MC Library
Worksheets("MC library").Activate
Set Data = Sheets("MC library")
Dim loc As Range
Dim rang As Range
Dim spce As Range
Dim mass() As Single
Dim Found As Variant
Set rang = Sheets("MC library").Range("C3:Z500")
Set loc = Sheets("MC library").Range("C3")

On Error Resume Next
Do
    Set Found = rang.Find(What:=searchn, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
    MsgBox (Found)
    Set loc = Sheets("MC library").Range(Found.Address)
    If Found > 0 Then
        ReDim Preserve mass(i)
        mass(i) = Found
        i = i + 1
        Set rang = Sheets("MC library").Range(loc, "Z500")
    End If

Loop Until Found Is Nothing

End Sub

[/code]

This is all a work in progress so there's a few things in there that aren't relevant yet. The Do loop is where the real problems kick in.

searchn calls in a value from a cell that is an input for the search from the user and is typically a four-digit number. The MsgBox line is simply used for debugging and won't be in the final version.

Any suggestions and help would be greatly appreciated. The biggest issue (I think), is finding a way to store the location of a cell in a variable and then using that to change the range as I go.

  • http://www.cpearson.com/excel/findall.aspx has a good explanation – Tim Williams Sep 22 '17 at 05:18
  • @TimWilliams I tried the solution found there, modifying slightly to include the range etc. that I want but it doesn't do anything. All I did was set the range and value: `code` Set SearchRange = Range("C3:Z500") FindWhat = Sheets("Search").Range("C2").Value `/code` And changed LookAt to xlPart instead of xlWhole since I'm looking for everything that contains the input numbers. – Brittany Roberts Sep 22 '17 at 20:29
  • Nevermind! It does work! I just expected an output. Thanks so so much! Now just to modify to do the rest of what I want :P – Brittany Roberts Sep 22 '17 at 20:51
  • OK glad you figured it out. – Tim Williams Sep 22 '17 at 21:01

2 Answers2

0

here is a find routine that works

Sub findAll()

    Dim aaa As Range

    With ActiveSheet.Cells
        Set aaa = .Find(3, LookIn:=xlValues)  ' find number 3
        If Not aaa Is Nothing Then
            firstFind = aaa.Address
            Do
                Debug.Print aaa.Address, aaa.Value
                Set aaa = .FindNext(aaa)
            Loop While aaa.Address <> firstFind 
        End If
    End With

End Sub
jsotola
  • 2,238
  • 1
  • 10
  • 22
  • You don't need the `Not aaa Is Nothing` bit in the loop. – Darren Bartrup-Cook Sep 22 '17 at 07:53
  • @jsotola@ with greate thanks for [this](https://stackoverflow.com/questions/45989548/how-can-creating-dbf-file-and-define-encoding-in-notepad-or-vba), I presented you my last effort in that matter? in [this](https://ufile.io/fl9qz) location – mgae2m Sep 22 '17 at 08:32
  • I tried this, adding my input from the cell for the search criteria: `[code] Dim searchn As Integer ' The value input for the search If IsNumeric(Sheets("Search").Range("C2")) Then searchn = Sheets("Search").Range("C2").Value End If ... With ActiveSheet.Cells Set aaa = .Find(searchn, LookIn:=xlValues) ' find searchn ... `[/code] and it did nothing. Any other suggestions? – Brittany Roberts Sep 22 '17 at 20:33
  • Found a solution! Thanks! – Brittany Roberts Sep 22 '17 at 20:52
  • @DarrenBartrup-Cook, thanks .... removed it .... it would get stuck in a loop, if someone deletes the first found cell, though – jsotola Sep 22 '17 at 21:11
0
Sub SearchLibrary()

    Dim searchn
    Dim shtData As Worksheet
    Dim hits As Collection, hit

    searchn = Sheets("Search").Range("C2").Value

    If Len(searchn) = 0 Or Not IsNumeric(searchn) Then
        MsgBox "Search term should be numeric!", vbExclamation
        Exit Sub
    End If

    Set shtData = Worksheets("MC library")

    Set hits = FindAll(shtData.Range("C3:Z500"), searchn)
    For Each hit In hits
        Debug.Print hit.Address, hit.Value
    Next hit

End Sub



Public Function FindAll(rng As Range, v) As Collection
    Dim rv As New Collection, f As Range
    Dim addr As String
    Set f = rng.Find(what:=v, after:=rng.Cells(1), _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False)
    If Not f Is Nothing Then addr = f.Address()
    Do Until f Is Nothing
        rv.Add f
        Set f = rng.FindNext(after:=f)
        If f.Address() = addr Then Exit Do
    Loop
    Set FindAll = rv
End Function
Tim Williams
  • 154,628
  • 8
  • 97
  • 125