ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Find all then paste not working. (https://www.excelbanter.com/excel-programming/343688-find-all-then-paste-not-working.html)

Mark Cover

Find all then paste not working.
 
Here is the situation. I have this code and it is working fine except one
thing. I would like to paste all of the cells that are found, as it stands
now it is only finding and pasting the first instance of a word. ie. if you
search for a word that is in the ss twice it is only finding the first one.
Thanks
Code:
Private Sub cmdFind_Click()
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngCopyTo As Range

Set wksCopyTo = Sheets("Search_Add")
For Each wksCopyFrom In Worksheets
If wksCopyFrom.Name < wksCopyTo.Name And _
wksCopyFrom.Name < "Search_Add" Then 'sheets you don't want searched
Set rngToSearch = wksCopyFrom.Cells
Set rngFound = rngToSearch.Find(txtFind.Text, , xlValues,
LookAt:=xlPart)
If Not rngFound Is Nothing Then
'If rngCopyTo.Offset.Value < "" Then
'rngFound.Offset(1, 0).EntireRow.Insert
Set rngCopyTo = wksCopyTo.Cells(Rows.Count,
"A").End(xlUp).Offset(1, 0)
rngFound.EntireRow.Copy rngCopyTo
End If
End If
'End If
Next wksCopyFrom
txtFind.Text = ""
Sheets("Search_Add").Activate
End Sub

Tom Ogilvy

Find all then paste not working.
 
Private Sub cmdFind_Click()
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngCopyTo As Range
Dim sAddr as String

Set wksCopyTo = Sheets("Search_Add")
For Each wksCopyFrom In Worksheets
If wksCopyFrom.Name < wksCopyTo.Name And _
wksCopyFrom.Name < "Search_Add" Then 'sheets you don't want
searched
Set rngToSearch = wksCopyFrom.Cells
Set rngFound = rngToSearch.Find(txtFind.Text, _
, xlValues, LookAt:=xlPart)
If Not rngFound Is Nothing Then
sAddr = rngFound.Address
do
Set rngCopyTo = wksCopyTo.Cells(Rows.Count, _
"A").End(xlUp).Offset(1, 0)
rngFound.EntireRow.Copy rngCopyTo
set rngFound = rngToSearch.FindNext(rngFound)
loop while sAddr < rngFound.Address
End If
End If
Next wksCopyFrom
txtFind.Text = ""
Sheets("Search_Add").Activate
End Sub

--
Regards,
Tom Ogilvy


"Mark Cover" wrote in message
...
Here is the situation. I have this code and it is working fine except one
thing. I would like to paste all of the cells that are found, as it

stands
now it is only finding and pasting the first instance of a word. ie. if

you
search for a word that is in the ss twice it is only finding the first

one.
Thanks
Code:
Private Sub cmdFind_Click()
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngCopyTo As Range

Set wksCopyTo = Sheets("Search_Add")
For Each wksCopyFrom In Worksheets
If wksCopyFrom.Name < wksCopyTo.Name And _
wksCopyFrom.Name < "Search_Add" Then 'sheets you don't want

searched
Set rngToSearch = wksCopyFrom.Cells
Set rngFound = rngToSearch.Find(txtFind.Text, , xlValues,
LookAt:=xlPart)
If Not rngFound Is Nothing Then
'If rngCopyTo.Offset.Value < "" Then
'rngFound.Offset(1, 0).EntireRow.Insert
Set rngCopyTo = wksCopyTo.Cells(Rows.Count,
"A").End(xlUp).Offset(1, 0)
rngFound.EntireRow.Copy rngCopyTo
End If
End If
'End If
Next wksCopyFrom
txtFind.Text = ""
Sheets("Search_Add").Activate
End Sub




Mark Cover

Find all then paste not working.
 
Tom,
Works like a charm..
you are the man thinks so much for your help.

"Tom Ogilvy" wrote:

Private Sub cmdFind_Click()
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngCopyTo As Range
Dim sAddr as String

Set wksCopyTo = Sheets("Search_Add")
For Each wksCopyFrom In Worksheets
If wksCopyFrom.Name < wksCopyTo.Name And _
wksCopyFrom.Name < "Search_Add" Then 'sheets you don't want
searched
Set rngToSearch = wksCopyFrom.Cells
Set rngFound = rngToSearch.Find(txtFind.Text, _
, xlValues, LookAt:=xlPart)
If Not rngFound Is Nothing Then
sAddr = rngFound.Address
do
Set rngCopyTo = wksCopyTo.Cells(Rows.Count, _
"A").End(xlUp).Offset(1, 0)
rngFound.EntireRow.Copy rngCopyTo
set rngFound = rngToSearch.FindNext(rngFound)
loop while sAddr < rngFound.Address
End If
End If
Next wksCopyFrom
txtFind.Text = ""
Sheets("Search_Add").Activate
End Sub

--
Regards,
Tom Ogilvy


"Mark Cover" wrote in message
...
Here is the situation. I have this code and it is working fine except one
thing. I would like to paste all of the cells that are found, as it

stands
now it is only finding and pasting the first instance of a word. ie. if

you
search for a word that is in the ss twice it is only finding the first

one.
Thanks
Code:
Private Sub cmdFind_Click()
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngCopyTo As Range

Set wksCopyTo = Sheets("Search_Add")
For Each wksCopyFrom In Worksheets
If wksCopyFrom.Name < wksCopyTo.Name And _
wksCopyFrom.Name < "Search_Add" Then 'sheets you don't want

searched
Set rngToSearch = wksCopyFrom.Cells
Set rngFound = rngToSearch.Find(txtFind.Text, , xlValues,
LookAt:=xlPart)
If Not rngFound Is Nothing Then
'If rngCopyTo.Offset.Value < "" Then
'rngFound.Offset(1, 0).EntireRow.Insert
Set rngCopyTo = wksCopyTo.Cells(Rows.Count,
"A").End(xlUp).Offset(1, 0)
rngFound.EntireRow.Copy rngCopyTo
End If
End If
'End If
Next wksCopyFrom
txtFind.Text = ""
Sheets("Search_Add").Activate
End Sub






All times are GMT +1. The time now is 11:13 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com