Sagar,
I couldn't get your code to work, problems with index, and the Offset
statements so I recut parts of it. Also it relied on the active sheet being
Search Results which is not necessary, so I changed that as well.
Before I give the code a few comments.
There is some good code here, you learn fast. The use of setting object
variables
I like to avoid goto's, so this
can be used without goto's like so
If you stay in these groups long, you are bound to come across the mantra
that '... it is rarely necessary to select anything ...'. So these lines
are better written without selects as
Rows.Count is a constant per sheet, but as it will be the same for any
sheet, you do not need to qualify it with the worksheet,
so you can just use
On the target sheet, you try an recalculate the next free row each time
(using a good technique), but there are a few [problems here
First, you cannot have a row or column of zero in a Cells property, it has
to start at 1.
You don't then need to Offset index,0, that does nothing when index is 0,
and introduces the blank lines as index increments
You don't need FormulaR1C1 property, Value is sufficient
After loading the target sheet, you load again at activecell!
And finally here, you don't need to iterate up from the bottom in this way
as you already have a row counter that you can use, index
Net result
Similarly, when copying the row
all comes together as
Sub SearchMacro()
Application.ScreenUpdating = False
Dim myInputName As Variant
Dim mySheetName As String
Dim index As Integer
Dim myOutputWs As Worksheet
Dim myCurrentWs As Worksheet
Dim foundCell As Range
Dim firstResult As String
Set myOutputWs = Worksheets("Search Results")
'Input Box to get the string to search
Do
myInputName = Application.InputBox("Please enter the string to
Search ")
If myInputName = "False" Then Exit Sub
Loop Until myInputName <> ""
' Counter initialization
index = 1
'Clear the cells in the Macro worksheet and select the first row
myOutputWs.Cells.ClearContents
'Iterate through the worksheets
For Each myCurrentWs In ActiveWorkbook.Worksheets
'Get the name of the sheet
mySheetName = myCurrentWs.Name
'Check to see if the worksheet is outlook
If Not UCase(mySheetName) Like "*OUTLOOK*" Then
'do nothing
Else
'Insert the Worksheet Name at the right offset
myOutputWs.Cells(index, 1).Value = mySheetName
index = index + 1
On Error Resume Next
'Retrieve the matching cell
Set foundCell = myCurrentWs.Columns().Find(what:=myInputName)
On Error GoTo 0
If Not foundCell Is Nothing Then
firstResult = foundCell.Address
Do
'Paste the entire row with the right offset
foundCell.EntireRow.Copy Destination:= _
myOutputWs.Cells(index, "A")
index = index + 1
Set foundCell = myCurrentWs.Cells.FindNext(foundCell)
Loop While Not foundCell Is Nothing And foundCell.Address <>
firstResult
End If
End If
Next myCurrentWs
Application.ScreenUpdating = True
End Sub
--
HTH
Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
Sagar said:
Thanks again Bob,
I'm almost there thanks to the numerous online resources and your
roadmap, but I'm having some formatting issues.
I'm able to retrieve the rows and paste them onto the new worksheet.
The final result worksheet is expected to be like
10 Day Outlook (The worksheet name)
Done Dave Avg (The matching rows)
15 Day Outlook (The worksheet name)
Inc Dave Good (The matching rows)
But unfortunately I get something like
10 Day Outlook (The worksheet name)
Done Dave Avg (The matching rows)
15 Day Outlook (The worksheet name)
Inc Dave Good (The matching rows)
Done Dave Good (The matching rows)
The problem is that numerous empty rows are being inserted between the
title and the first matching row which is propotional to the index
that I'm using. Could you help me figure out where I'm going wrong?
This is the code that I have (Please excuse the mess, 'coz as I said
it's a collage of a lot of different things. Hopefully I get better at
this
)
Option Explicit
Sub SearchMacro()
Application.ScreenUpdating = False
Dim myInputName As Variant
Dim mySheetName As String
Dim index As Integer
Dim myOutputWs As Worksheet
Dim myCurrentWs As Worksheet
Dim foundCell As Range
Dim firstResult As String
Set myOutputWs = Worksheets("Search Results")
TryAgain:
'Input Box to get the string to search
myInputName = Application.InputBox("Please enter the string to
search")
If myInputName = "False" Then Exit Sub
If myInputName = "" Then GoTo TryAgain
' Counter initialization
index = 0
'Clear the cells in the Macro worksheet and select the first row
myOutputWs.Cells.Select
Selection.ClearContents
Rows("1:1").Select
'Iterate through the worksheets
For Each myCurrentWs In ActiveWorkbook.Worksheets
'Get the name of the sheet
mySheetName = myCurrentWs.Name
'Check to see if the worksheet is outlook
If Not UCase(mySheetName) Like "*OUTLOOK*" Then
'do nothing
Else
'Insert the Worksheet Name at the right offset
myOutputWs.Cells(index, 0).End(xlUp).Offset(index,
0).FormulaR1C1 = mySheetName
ActiveCell.FormulaR1C1 = mySheetName
index = index + 1
On Error Resume Next
'Retrieve the matching cell
Set foundCell =
myCurrentWs.Columns().Find(what:=myInputName, _
after:=myCurrentWs.Cells.SpecialCells(xlCellTypeLastCell), _
LookIn:=xlFormulas, _
lookat:=xlPart, _
MatchCase:=False)
On Error GoTo 0
If Not foundCell Is Nothing Then
firstResult = foundCell.Address
Do
'Paste the entire row with the right offset
foundCell.EntireRow.Copy _
Destination:=myOutputWs.Cells(myOutputWs.Rows.Count,
"a").End(xlUp).Offset(index, 0)
index = index + 1
Set foundCell =
myCurrentWs.Cells.FindNext(foundCell)
Loop While Not foundCell Is Nothing And
foundCell.Address <> firstResult
End If
End If
Next myCurrentWs
Application.ScreenUpdating = True
End Sub
"Bob Phillips" <
[email protected]> wrote in message For
Each to
find test
if row
with
