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
        smcgrath171 Posts 4 Registration date Monday February 29, 2016 Status Member Last seen March 1, 2016 - Mar 1, 2016 at 01:25 PM
        Related:         
- Only partial return of search for copy and paste rows
 - How to search for words on websites - Guide
 - Thunderbird return receipt - Guide
 - Get rid of search baron - Guide
 - Partial match excel - Guide
 - Search nearby friends on facebook - Guide
 
        
    
    
    
    
Mar 1, 2016 at 07:17 AM
Mar 1, 2016 at 10:55 AM
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
Mar 1, 2016 at 01:25 PM
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