Find Multiple Values, Copy Entire Row & Paste

[ryguy7272]

I wanted to filter several columns for values that match a certain criteria.
Then I thought a copy/paste routine would work better (there are too many
columns to use the filter tool). I found this simple cut/paste code on this
DG a while back and I tried to use it today and it didn’t do anything. Can
someone please tell me why?


Sub a()
Dim Cell As Range
Dim CutRg As Range
For Each Cell In Sheet1.Range("AR1:BJ2000")
If Cell.Value = "sam" Then
If CutRg Is Nothing Then
Set CutRg = Cell.EntireRow
Else
Set CutRg = Union(CutRg, Cell.EntireRow)
End If
End If
Next
If Not CutRg Is Nothing Then
CutRg.Copy Sheet2.Range("A1")
CutRg.Delete
End If
End Sub

There may be multiple instances of the value sought in multiple
columns/rows. I am hoping to copy the entire row if even one instance of the
value is found.


Thanks,
Ryan---

 

[Michael]

It worked fine for me, considering that I have the word sam in colum AR on
sheet1; check to make sure your references are correct ie.: Sheet1, Sheet2
and column AR, if the sheet names are not the default change your code to
reflect the proper names, if the data is not on AR change the column
reference and also check your destination.

 

[Tom Ogilvy]

That would work if any cells within the range "AR1:BJ2000" contain "sam"
(case sensitive) and only "sam"

It worked for me.

 

[Otto Moehrbach]

Ryan
There are several things wrong with your code. For one thing, it's
inefficient because you are looping through each and every cell in a rather
large range when what you are really interested in is finding out if any
cell in any row has "sam". That is, you are not interested in what cell has
"sam", just in what row has "sam". Is this correct?
Your copy/paste commands are both after the For loop. What this means is
that you will paste into A1 of Sheet2 the row of only the last instance of
"sam". Is it your intention to paste into Sheet2 every row that has "sam"
in any cell? If so, the copy/paste should be within the For loop.
If I understand what you want to do, your code logic should be something
like:
Set the destination as A1 of Sheet2.
Set the range of Column AR.
Loop through all the cells in that range.
For each cell, Search the entire row (AR to BJ) for "sam" using the Find
command.
Copy/paste the entire row if "sam" is found.
Increment the destination cell one cell down.
Loop to the next cell in Column AR.
Done.
Post back if you need more. HTH Otto

 

[Tom Ogilvy]

Otto,
I don't think you have taken the time to understand the code or have
misunderstood it. I will agree that it is inefficient from a looping every
cell standpoint, but it works fine and does only one copy and paste after
building a range to all rows that need to be copied. So that should not be
moved inside the loop and that aspect is very efficient.

 

[ryguy7272]

Thanks for getting back to me guys. I don’t know why it doesn’t work; it
just doesn’t do anything at all.

So, anyway, I tried a different method. I figured I would delete all rows
that don’t match my criteria. I thought the code below would do the trick,
but again, it gives me false results (at least Excel actually does something
this time).

‘I use this function to delay the search for a bit
‘It prevents the app. from running too fast and skipping some data
Public Function HalfSecDly()
s = Timer + 0.1
Do While Timer < s
DoEvents
Loop
End Function


Sub DeleteRows()
Dim wSheet As Worksheet
myValue = "sam"
Set myrange = ActiveSheet.Range("AR1:BJ1600")
For Each c In myrange
c.Select
If c.Value <> myValue Then Selection.EntireRow.Delete
HalfSecDly
Next c
End Sub


Again, it gives me incorrect results. Many rows, which don’t contain any
reminisce of “samâ€, remain. Any thoughts on this one? All I’m trying to do
is create a pseudo multi-filter, or multi-sort, for about 19 columns. Speed
isn't an issue, but accuracy is!

Regards,
Ryan--

 

[Tom Ogilvy]

If AR1 = sam , it doesn't delete row 1, but when it checks AS1, and Sam is
not found, Row 1 is deleted.

 

[ryguy7272]

I guess I should go with Otto's recommendation. How can I get the macro to
evaluate AR:BJ for each row, and delete the entire row if no matching
criteria are found in that ENTIRE range?

Thanks again!
Ryan--

 

[Otto Moehrbach]

Thanks Tom. I missed that. Otto

Otto,
I don't think you have taken the time to understand the code or have
misunderstood it. I will agree that it is inefficient from a looping
every
cell standpoint, but it works fine and does only one copy and paste after
building a range to all rows that need to be copied. So that should not
be
moved inside the loop and that aspect is very efficient.

 

[Otto Moehrbach]

Ryan
This macro should do what you want. Note that I assumed that your data
in Column AR has entries in at least the first and last rows of whatever
your data range is. HTH Otto
Sub a()
Dim Cell As Range
Dim RngColAR As Range
Dim RngToSearch As Range
Dim c As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set RngColAR = Range("AR1", Range("AR" & Rows.Count).End(xlUp))
For c = RngColAR.Count To 1 Step -1
Set RngToSearch = Range(Cells(RngColAR(c).Row, 44),
Cells(RngColAR(c).Row, 62))
If RngToSearch.Find(What:="sam", LookAt:=xlWhole) Is Nothing
Then _
RngToSearch(c).EntireRow.Delete
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[RyGuy]

Thanks for the code Otto!! It is insightful and it seems to work pretty
well, but like the code that I was using before, the final results are
incorrect. The code returns 265 records (rows) and when I apply several
manual filters I get 127 records. I tried a couple of times; not sure why
the code returns extraneous information. If I have time later I will
investigate these discrepancies further. Anyway, thanks for the help.

Regards,
Ryan---