Previous Topic Next Topic

Macro to copy row in new sheet if text found

Closed
edz - Aug 26, 2010 at 07:14 PM
 edz - Aug 26, 2010 at 08:02 PM
Hello,


I need help in creating a macro that will copy all rows of a sheet into a new sheet if a text is found.

The sheet with the data is called "Codigos"
Data ranges from cell A5 to G188

I need to search for a specific word in this sheet and copy every row where the word is found into another sheet called "Resultados"

Please help.

1 response

Answer 1 / 1
edz
Aug 26, 2010 at 08:02 PM
So far I ahve this code. The only rpoblem is that it is only able to find cells that only have one word. for examble if I search for "you" it finds and copy as long as the cell has only "you".

If the cell has "you and only you" the code those not recognize this as containing you.

Help will be appreciated.

Public Sub Tester()
Dim Rng As Range
Dim rCell As Range
Dim copyRng As Range
Dim destRng As Range
Dim WB As Workbook
Dim SH As Worksheet
Dim CalcMode As Long
Dim arr As Variant
Dim res As Variant

Set WB = ActiveWorkbook
Set SH = WB.Sheets("Codigos")
Set Rng = SH.Range("A5:G188")
Set destRng = WB.Sheets("Resultados").Range("A5")

res = InputBox("Enter search words separated with a space")

If res = "" Then Exit Sub
arr = Split(res, " ")

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In Rng.Cells
If Not IsError(Application.Match(rCell.Value, arr, 0)) Then
If copyRng Is Nothing Then
Set copyRng = rCell
Else
Set copyRng = Union(rCell, copyRng)
End If
End If
Next rCell

If Not copyRng Is Nothing Then
copyRng.EntireRow.Copy Destination:=destRng
Else
'nothing found, do nothing
End If

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub
0