Only partial return of search for copy and paste rows

[Closed]
Report
Posts
5
Registration date
Monday February 29, 2016
Status
Member
Last seen
March 1, 2016
-
Posts
5
Registration date
Monday February 29, 2016
Status
Member
Last seen
March 1, 2016
-
Hello,

I have a workbook with multiple worksheets with same format that has data in A4:K15 that I would like to search by any field and have the results copy and paste to the "SEARCH" worksheet. The below works, but only returns some of the results (doesn't return all rows with the search string). Any help will be appreciated and I am trying to attached a copy of the test workbook here, but can't figure out.....

Public Sub FindText()

Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer

myText = InputBox("Enter Search")

If myText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws

If ws.Name = "Master" Then GoTo MyNext
If ws.Name = "Lists" Then GoTo MyNext

Set cfind = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If cfind Is Nothing Then GoTo MyNext
cfind.EntireRow.Copy
With Worksheets("SEARCH")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With
MyNext:
End With
Next

1 reply

Perhaps the value in the sheet is not an 'exact' match to the value you entered.
It may have trailing spaces for example.

Replace the LookAt:=xlWhole with LookAt:=xlPart and see if you get more matches returned.
Posts
5
Registration date
Monday February 29, 2016
Status
Member
Last seen
March 1, 2016

I tried the above and having same results... If possible I would like to send you the workbook, so you can see it function?
Posts
5
Registration date
Monday February 29, 2016
Status
Member
Last seen
March 1, 2016

I got it to work by adding some other code I found on site; now the issue is clearing the previous results when conducting another search? here is the tweaked code:

Public Sub FindText()

Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer

myText = InputBox("Enter text to find")

If myText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws

If ws.Name = "Master" Then GoTo myNext
If ws.Name = "Lists" Then GoTo myNext

Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

If Not Found Is Nothing Then
FirstAddress = Found.Address

Do
foundNum = foundNum + 1
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
Found.EntireRow.Copy
With Worksheets("SEARCH")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With

Set Found = .UsedRange.FindNext(Found)

Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If

myNext:
End With

Next ws

If Len(AddressStr) Then
MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
AddressStr, vbOKOnly, myText & " found in these cells"
Else:

MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If
End Sub
Posts
5
Registration date
Monday February 29, 2016
Status
Member
Last seen
March 1, 2016
>
Posts
5
Registration date
Monday February 29, 2016
Status
Member
Last seen
March 1, 2016

So I keep searching and playing with it and find solutions. I am now able to clear the search results when researching... the last issue I have is that in some rows I have duplicate names in multiple fields and when searching by name it causes issues (moves names to the following row). Is there a way that if K: = G: to only copy the row once and continue the search?

Here is the most recent code:

Sub FindText()

Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer
Dim lastrow As Integer


Sheets("SEARCH").Range("A4:K50").ClearContents


myText = InputBox("Enter text to find")

If myText = "" Then Exit Sub


For Each ws In ThisWorkbook.Worksheets
With ws

If ws.Name = "Master" Then GoTo myNext
If ws.Name = "Lists" Then GoTo myNext

Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

If Not Found Is Nothing Then
FirstAddress = Found.Address

Do
foundNum = foundNum + 1
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
Found.EntireRow.Copy
With Worksheets("SEARCH")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With

Set Found = .UsedRange.FindNext(Found)

Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If

myNext:
End With

Next ws

If Len(AddressStr) Then
MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
AddressStr, vbOKOnly, myText & " found in these cells"
Else:

MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If
End Sub