Auto Find (CTRL-F) in batch, and store results, macro. 1

[nat101]

How complex is it to have a macro automatically find ALL ocurrences of 'target', and store the rows/refs of the hits on a separate sheet.

In my workbook, I have many sheets, all of which have a table/database in range D14:AA128. I would like to find ALL the hits for a specific number/string in ANY cell, and store the rows on another sheet(results).

Much appreciated!

 

[Databaseguy]

You'd probably be better off using the VLookup function. Browse the help for it, it's a little tricky to implement sometimes...

 

[Goska]

This sub matches any item in the range D14:AA128 with the value in cell A1, then places the cell name (A1, B6, etc) in column A of sheet2, in the order that it finds them. Note that there is no delete in here, so old values will not go away unless you code that in too. I think this is what you are looking for.

Sub myfind()
Dim FindMeHere As String
Dim i As Integer
Dim c As Object
Dim firstaddress As String
i = 0

FindMeHere = Range("a1&quot
With Sheets("sheet1&quot.Range("D14:AA128&quot
Set c = .Find(FindMeHere, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
i = i + 1
Sheets("sheet2&quot.Cells(i, 1) = firstaddress
Set c = .FindNext(c)
Sheets("sheet1&quot.Select
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
End Sub

 

[nat101]

DatabaseGuy, I played with vLookup, but I need more like a FIND function. Wadda you say to Goska's post?!

Goska: THANKS!!

Looks like it will cut it (can't try it right now). The only change I need is to store the entire ROW, D-AA, in sheet2. Although the exact cell of the hit is important to me, the real thing we need here is the data in the row that contains the hit. (How about BOLDING the 'hit' cell?<g>)

And it would be nice..(Sorry! Only if not hard!) if sheet2 will contain an additional column, AB, with the hypertext address of the original hit.

Thanks a million.

 

[Databaseguy]

Yeah, nat101 is close. Go to the VBE and search the help file for the find method. Miscrosofts example actually changes the format of the cell where the matching value is found. You'll have to tweak the last little bit of his code to populate the second sheet. Between the MS example and nar101s code you should get it...

 

[Goska]

Actually, my code was just a hack and paste from the Excel help files to begin with.

Working on the next solution. THought it was just really slow. Turned into an infinte loop. And of course I didn't save it before I ran it.

 

[Goska]

Here is the working version. Copies the info to the next sheet, gives a cell ref first, then pastes the data. Cell refs are only once per row; multiple occurances in a row are eliminated. I hate cosmetics, but here you go. If you leave copy statement 1 in, then it will bold both the original cell and the new output cell hit. You do not need 2 if you have 1. If you want only the original, remove copy statement 1.

Sub myfind()
Dim FindMeHere As String
Dim i As Integer
Dim c As Object
Dim firstaddress As String
Dim NextAddress As String
Dim RowReff As Integer
Dim OldRow As Integer
Dim CopyReff As String

i = 0
OldRow = 0

Sheets(&quot;SHEET2&quot.Select
Range(&quot;A1:AA128&quot.Select
Selection.ClearContents
Sheets(&quot;sheet1&quot.Select

FindMeHere = Range(&quot;a1&quot
With Sheets(&quot;sheet1&quot.Range(&quot;D14:AA128&quot
Set c = .Find(FindMeHere, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
NextAddress = firstaddress
Do
NextAddress = c.Address
RowReff = Right(NextAddress, 1) + 10
CopyReff = &quot;D&quot; & RowReff & &quot;:AA&quot; & RowReff
'1
Range(NextAddress).Font.Bold = True
If (OldRow <> RowReff) Then
i = i + 1
Range(CopyReff).Select
Range(CopyReff).Copy
Sheets(&quot;sheet2&quot.Cells(i, 1) = NextAddress
Sheets(&quot;sheet2&quot.Cells(i, 2).PasteSpecial
End If
'2
Range(NextAddress).Font.Bold = True
Set c = .FindNext(c)
Sheets(&quot;sheet1&quot.Select
OldRow = RowReff
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
End Sub

 

[nat101]

Thank you much!
Shall give it a whirl tonite at my evening job's computer.
Hope the results of the entire FIND of ALL sheets end up on one sheet, the last one. Yes?

 

[nat101]

Goska,

First, thanks a million for the effort. Maybe I didn’t comment out the appropriate code (I commented out ONE line below ‘1 in your code), but the thing is ‘almost’ working. Here is a short laundry list. And thanks again and again…

I think it works differently if searching a string or a number, I would like to mimick CTRL-F exactly, ie, even if searching numbers, it can return partial hits, ie 345 in a cell containing 123456 is true. (If ‘entire cells’ is not checked.).

I cannot pinpoint when, but many times myfind returns ONLY the refs in column A of “FOUND/RESULTS”, and not the row, EXCEPT for the last hit, where it correctly returns the entire row. And at least once it returned the NEXT row of the hit.

Also, Instead of the hit value sometimes it displays, TRUE VALUE on the results/found page row, in the cell of the hit. And it also replaced the ORIGINAL cell with TRUE VALUE. (Don’t worry, I am working of test copies of the data.)

Please, I do not want to bold the original sheet, only the target result/found sheet.

And pretty please, I usually need to loop thru many sheets, and the names are unpredictable across workbooks, but they all contain the database/table in the same range. So, can I have it start the FIND at the current sheet and loop repeat the myfind on the next…, until it hits the “FOUND/RESULTS” sheet.

If the BOLDING is driving you nuts, dump it.

THANK YOU!!!!!!!!!!!!!!!!!!!!!!!

 

[Goska]

Worry about bolding later.

Set c = .Find(FindMeHere, LookIn:=xlValues,LookAt:=xlPart,MatchCase:=False)

Swap this line for the old one. It should be able ot find stuff in the middle of a string/number, and it ignores the case of the letters.

RowReff = Right(NextAddress, 1) + 10
might need the 10 played with to get it right. Change it around in +/-1 increments and see if that helps. I think it will also take care of some of your other problems. I didn't test all possible scenarios, and apparently you found some that I didn't test. If you are still having problems with the 10 after playing with it, then see if you can find the errors that are setting this off. I think all of your errors are coming from this. I forget why I set it to 10, looking back, I think it should be 13 or 14, but I think I had some problems with those. Find specific errors and I will help you from there. Try stepping through the code using F8 in the VBA editor and turn on some watches, and see if you can find it.

Here is some chunks of code for adding/formatting sheets that you may want to play with. I got busy today and I don't have the time to finish this off for you, but this psuedo code should be enough to get you started. If you need more code, use the macro recorder and that will show you almost anything.

ActiveWorkbook.Worksheets.Add
with activeworksheet
.name=somthing
end with

Range(&quot;A:A&quot.ColumnWidth = 8
If it isn't working, post again tommorow and I will look at it again when I get hte email notification.

 

[nat101]

Thank you much, will try it soon.

Can you please explain what that rowreff line (+x) is supposed to do?

Thanks

PS Maybe I can sneak a try at it now.

 

[Goska]

NextAddress is the address of a cell &quot;c&quot;, ie &quot;A9&quot;

right(NextAddress,1) returns the rightmost character in the string NextAddress. You could use 2 to return the 2 right values, and tehre is also a left() available if you ever need it. But the Right() should get the row number of the cell that we are in. It is screwy because of the named range that we are using. I think it is a problem with not defining the active cell, so that may be why I got a 10 instead of a 13. Really, I think it should be 0. I am going to have to do some more playing later this afternoon and I will get back to you.

NextAddress = c.Address
RowReff = Right(NextAddress, 1) + 10

After these 2 lines, add the 3rd
Selection.ClearContents
Sheets(&quot;sheet1&quot.Select
range(&quot;a1&quot.select

The following existing code should be changed from:
'2
Range(NextAddress).Font.Bold = True
Set c = .FindNext(c)
Sheets(&quot;sheet1&quot.Select
to:
Sheets(&quot;sheet1&quot.Select
range(&quot;a1&quot.select
Set c = .FindNext(c)

Looking back at all of this, it should work now, but I have some work to do and I accidently lost my test cases, so it may be awhile.

 

[Goska]

Found the problem. I was truncating 14 into 4. I have the solution, working on some other fixes right now.

 

[Goska]

Here it is. The bolding is not perfect, I do not get any errors, but there are occasions for duplicate entries, and I can clear the contents of the row, but not delete the row. I have some big changes going on through work starting Monday, so this is probably going to be one of my last posts on TekTips. This should be enough for you.


Option Explicit

Sub myfind()
Dim FindMeHere As String
Dim i As Integer
Dim Num As Integer
Dim c As Object
Dim d As Object
Dim firstaddress As String
Dim NextAddress As String
Dim RowReff As Integer
Dim OldRow As Integer
Dim CopyReff As String
Dim MyName As String
Dim ws As Worksheet
Dim SheetNam As String


i = 0
OldRow = 0

Call Module1.ME2(MyName)


Sheets(&quot;sheet1&quot.Select
FindMeHere = Range(&quot;a1&quot

For Each ws In Worksheets
RowReff = 0
If (ws.Name <> MyName) Then
'BadName = Left(ws.Name, 5)
'If (BadName <> &quot;FINAL&quot Then
ws.Select
With ActiveSheet.Range(&quot;D14:AA128&quot
Set c = .Find(FindMeHere, LookIn:=xlValues, LOOKAT:=xlPart, SEARCHORDER:=xlByRows)
If Not c Is Nothing Then
firstaddress = c.Address
NextAddress = firstaddress
Range(&quot;D14&quot.Select
Do
NextAddress = c.Address
RowReff = c.Row
CopyReff = &quot;D&quot; & RowReff & &quot;:AA&quot; & RowReff
Range(NextAddress).Font.Bold = True
If (OldRow <> RowReff) Then
i = i + 1
ws.Select
Range(CopyReff).Select
Range(CopyReff).Copy
SheetNam = ws.Name & RowReff
SheetNam = ws.Name & NextAddress
Sheets(MyName).Cells(i, 1) = SheetNam
SheetNam = ws.Name & RowReff
Sheets(MyName).Cells(i, 2) = SheetNam
Sheets(MyName).Cells(i, 4).PasteSpecial
End If
Range(NextAddress).Font.Bold = False
Set c = .FindNext(c)
ws.Select
Range(&quot;D14&quot.Select
OldRow = RowReff
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
End If
'End If
Next ws
Sheets(MyName).Select
i = i + 1
Cells(i, 2) = &quot;STOP&quot;

Num = i
With Sheets(MyName).Range(&quot;b:b&quot
For i = 1 To Num
FindMeHere = Cells(i, 2)
Set c = .Find(FindMeHere, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
RowReff = c.Row
If (RowReff <> i) Then
Sheets(MyName).Cells(RowReff, 3) = 1
Rows(RowReff).ClearContents
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
Next i
End With

End Sub


Sub ME2(MyNameHere As String)
Dim i As Integer
Dim ws As Worksheet
Dim Count As Integer
Dim CountNot As Integer
Dim Done As Boolean
Dim Maxx As Integer
Dim Num As Integer
Maxx = 500
Done = False
For i = 1 To Maxx
MyNameHere = &quot;FINAL&quot; & i
Count = 0
CountNot = 0
If (Done = False) Then
For Each ws In Worksheets
Count = Count + 1
If (ws.Name <> MyNameHere) Then
CountNot = CountNot + 1
End If
Next ws
If (CountNot = Count) Then
Done = True
Num = i
End If
End If
Next i
Sheets.Add
MyNameHere = &quot;FINAL&quot; & Num
ActiveSheet.Name = &quot;FINAL&quot; & Num
End Sub

 

[nat101]

Goska, thank you much!

I am planning to add some cutsy stuff to it, some bells and whistles, and some useful features and release it as freeware. I would like to give you an honorable mention/thank-you in the docs. So, if you will please email me your real name, etc.

(Might take a week or two until complete, though.)

 

[Goska]

Sure, but I don't have your email. Mine is Goska9@hotmail.com.