Excel Macro Help
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
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
can be used without goto's like so
Do
myInputName = Application.InputBox("Please enter the string to
Search ")
If myInputName = "False" Then Exit Sub
Loop Until myInputName < ""
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
'Clear the cells in the Macro worksheet and select the first row
myOutputWs.Cells.Select
Selection.ClearContents
Rows("1:1").Select
are better written without selects as
'Clear the cells in the Macro worksheet and select the first row
myOutputWs.Cells.ClearContents
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,
myOutputWs.Cells(myOutputWs.Rows.Count, "A").End(xlUp).Offset(index, 0)
so you can just use
myOutputWs.Cells(Rows.Count, "A").End(xlUp).Offset(index, 0)
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
'Insert the Worksheet Name at the right offset
myOutputWs.Cells(index, 0).End(xlUp).Offset(index,
0).FormulaR1C1 = mySheetName
ActiveCell.FormulaR1C1 = mySheetName
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
'Insert the Worksheet Name at the right offset
myOutputWs.Cells(index, 1).Value = mySheetName
index = index + 1
Similarly, when copying the row
'Paste the entire row with the right offset
foundCell.EntireRow.Copy _
Destination:=myOutputWs.Cells(myOutputWs.Rows.C ount,"a").End(xlUp).Offset
(index, 0)
index = index + 1
becomes
'Paste the entire row with the right offset
foundCell.EntireRow.Copy Destination:= _
myOutputWs.Cells(index, "A")
index = index + 1
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" wrote in message
m...
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(xlCellTypeLa stCell), _
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.Coun t,
"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" wrote in message
...
Lol. I figured that as you had the programming experience, it's the
object
model you need.
Just post back if you get stuck.
--
HTH
Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
"Sagar" wrote in message
om...
Thanks for your roadmap Bob. This should definitely help getting me
started off. Being completely new to Excel, I'm all the way upto
having the input box to get the Owner name already :)
"Bob Phillips" wrote in message
...
As you already have experience, I will just give you some pointers.
Use InputBox top prompt for the name.
There is a worksheets collection that you can iterate through using
For
Each
sh In Worksheets ... Next sh.
You Can use the Find method to find an occurrence, and the FindNext
to
find
others. With Find you can specify the range (Columns("B:B")), and
test
if
found.
When you do find, it will be a single cell. You can get the whole
row
with
cell.EntireRow.Copy, and then paste that.
Good luck.
--
HTH
Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
"Sagar" wrote in message
om...
Hi All,
I'm new to VBA programming although I have programming experience
with
Java, J2EE, C, C++ etc.
I have a xls file with multiple worksheets. Each worksheet has
three
columns which are shown below.
Status Owner Outlook
Now I have to write a macro which requires the user to input a
string
to search for an Owner and then will pull all worksheets which has
a
particular string in it's name (For e.g the string "Outlook" in
it's
name will require me to pull Worksheets "10 Day Outlook", "15 Day
Outlook" and not "10 day schedule), and copy the contents of the
row
that matches the "Owner" name that was input and then creates a
new
worksheet and pastes this onto the new Worksheet created.
For e.g., Given a excel spreadsheet with 3 worksheets
Worksheet "10 Day Outlook"
Status Owner Outlook
-------------------------
Done John Good
Done Dave Avg
Worksheet "15 Day Outlook"
Status Owner Outlook
-------------------------
Done Vicky Good
Inc Dave Good
Worksheet "10 Day Schedule"
Operation TargetDate
-------------------------
MeasK3Refl 4/27/04
This macro should ask for a name and if the user inputs say
"Dave",
should create a new worksheet with the contents
New Worksheet
Status Owner Outlook
-------------------------
Done Dave Avg
Inc Dave Good
Thanks a lot in advance for your help,
Sagar.
|