help with macro

[jhyatt]

i found this code and am trying to adjust for my needs but it keeps stopping
at the indicated line.

Sub test()
Call AddName("Pear")
End Sub

Public Sub AddName(ByVal Fruit As String)
Dim wks As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirstAddress As String

Set wks = ActiveSheet
Set rngToSearch = wks.Columns("A")

stops here
Set rngFound = rngToSearch.Find(What:=Fruit, _
LookIn:=xlConstants, _
LookAt:=xlPart)


If Not rngFound Is Nothing Then
Set rngFoundAll = rngFound
strFirstAddress = rngFound.Address
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
ThisWorkbook.Names.Add Fruit, rngFoundAll.Address
End If
End Sub

 

[OssieMac]

Hi Jhyatt,

I think that the only Lookin parameters are xlValues, xlFormulas and
xlComments.

Just as an added extra it is recommended that you set all the
arguments/parameters for find because they are saved from the previous find
even if it was done in the interactive mode.

Regards,

OssieMac

 

[JLGWhiz]

You should abandon this code and start over. It does nothing to nothing.
However,
It is stopping at the Set....Find statement because it cannot find the value
you define in the place you tell it to look...xlConstants. If you change
that to xlValues, then it should complete macro.

 

[OssieMac]

Hi again Jhyatt,

I decided to actually test your code and if you replace your find with the
following it works:-

Set rngFound = rngToSearch.Find(What:=Fruit, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
Regards,

OssieMac

 

[jhyatt]

Sorry it took so long to get back to you i changed the code as you suggested
and it works great. is there a way to have it look in multiple work sheets.

 

[OssieMac]

Hi again Jhyatt,

I don't think that you can set a union on multiple sheets or at least I
don't know how. What I have done is modify the code to step through all the
worksheets and set the interior color of the found cells to Yellow just to
give you an example of stepping through the worksheets.

Further to what JLG Whiz said, I am intrigued as to why you want to set a
union of the found cells or is this just a training example?

Sub test()
Call AddName("Pear")
End Sub

Public Sub AddName(ByVal Fruit As String)
Dim ws As Worksheet
Dim wks As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim strFirstAddress As String

'Repeat for each worksheet in workbook
For Each wks In Worksheets
Set rngToSearch = wks.Columns("A")

Set rngFound = rngToSearch.Find(What:=Fruit, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Do
'Set the interior color of found cell to Yellow
rngFound.Interior.ColorIndex = 6
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If
Next wks

End Sub


Regards,

OssieMac

 

[jhyatt]

sorry Ossiemac had go home and sleep.

my goal is to find all records in the workbook with the word trade (trades
of service)in them to put them on a separate sheet so we can track the trades
in our business. I have been trying different codes to figure out a way to
do this and this one seemed to have potential.

 

[OssieMac]

Hi again Jhyatt,

That explains that it was some sample code that you want to modify. In case
you need some further help, I have modified the code to copy the entire row
of the found data to a another worksheet named "Trade List". The code will
skip finding in the "Trade List" worksheet.

If you do not have column headers on the "Trades List" worksheet then you
will see that the code will leave a row blank at the top. That is just the
way the Destination code works with the End(xlUp).Offset(1,0).

Feel free to get back to me again if you need any further help.

Public Sub AddName(ByVal Fruit As String)
Dim wks As Worksheet 'Each worksheet in workbook
Dim wsList As Worksheet 'Worksheet with list
Dim rngToSearch As Range
Dim rngFound As Range
Dim strFirstAddress As String

'Edit to your worksheet name
Set wsList = Sheets("Trade List")
'Repeat for each worksheet in workbook
For Each wks In Worksheets
If wks.Name <> wsList.Name Then
Set rngToSearch = wks.Columns("A")

Set rngFound = rngToSearch.Find(What:=Fruit, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Do
'Copy entire row of record to new location
rngFound.EntireRow.Copy _
Destination:=wsList.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If

End If
Next wks

End Sub

Regards,

OssieMac

 

[jhyatt]

Hello Ossie

works great is there a way to copy only certain columns in those rows. like
A G H

 

[OssieMac]

Hi again Jhyatt,

Back a bit sooner than I anticipated. I must apologise because there was an
error in the last code that I posted. If you have any blank cells in columns
G or H than it will mess up. Replace the copy - Destination lines with these
lines which allocate the destination across from column A which will always
have something pasted to it before it tries to copy the other two columns. It
will not matter then if either column G or H have blank cells.

Note that if you need to change the column to which it is pasting then then
you chage the value in the Offset(0,1). Col 1 becomes column B because the
offset is counted as how many times you would press the right arrow to get to
it from the initial column which is A.

Of course if there are no blank cells in columns G or H then the initial
code will work.

'Copy specific cell of record to new location
rngFound.Copy _
Destination:=wsList.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0) 'Copies to Col A
rngFound.Offset(0, 6).Copy _
Destination:=wsList.Cells(Rows.Count, 1) _
.End(xlUp).Offset(0, 1) 'Copies to Col B
rngFound.Offset(0, 7).Copy _
Destination:=wsList.Cells(Rows.Count, 1) _
.End(xlUp).Offset(0, 2) 'Copies to Col C


Regards,

OssieMac