Previous Topic Next Topic

Only partial return of search for copy and paste rows

Closed
smcgrath171 Posts 4 Registration date Monday February 29, 2016 Status Member Last seen March 1, 2016 - Feb 29, 2016 at 12:06 PM
smcgrath171 Posts 4 Registration date Monday February 29, 2016 Status Member Last seen March 1, 2016 - Mar 1, 2016 at 01:25 PM
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

Related:

1 response

Answer 1 / 1
RayH
Feb 29, 2016 at 04:46 PM
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.
0
smcgrath171 Posts 4 Registration date Monday February 29, 2016 Status Member Last seen March 1, 2016
Mar 1, 2016 at 07:17 AM
I tried the above and having same results... If possible I would like to send you the workbook, so you can see it function?
0
smcgrath171 Posts 4 Registration date Monday February 29, 2016 Status Member Last seen March 1, 2016
Mar 1, 2016 at 10:55 AM
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
0
smcgrath171 Posts 4 Registration date Monday February 29, 2016 Status Member Last seen March 1, 2016 > smcgrath171 Posts 4 Registration date Monday February 29, 2016 Status Member Last seen March 1, 2016
Mar 1, 2016 at 01:25 PM
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
0

Similar discussions

Opening a corrupted Illustrator .ai file
BenjaminOwens -
williammcdowell -

1 response
Can no longer paste text into insta
6hypnone -
Richierichmeister -

6 responses
WOW equipment return
aakash12345_0667 -
HelpiOS -

1 response
How can I make my name text invisible in Discord
imbenmark -
imbenmark -

4 responses