If rows contains specific word, copy next two rows

Microsoft Office excel 2007 - upgrade
June 4, 2012 at 13:51:22
Specs: Windows 7
I am really new with VBS and need help.
I have sheet1 and sheet2. All my raw data is in sheet1 column A and sheet2 will be summary report. I want my script to search each cell in column A and search for "Grade A". If find, copy entired row which contains Grade A word and also copy next row and paste it in sheet2. Here is an example.
Sheet1:

A B C
GradeA sdfasdf sadfsadf
Address sadfas sdfsadfs
Grade B sadfsd dgfdsgdf
Address sdfasf ertertewt
Grade C fhgfdgh ukjtyuyt
GradeA hhh lll
Address ppp hhh

Sheet2 shoud look like this after running script.

A B C
GradeA sdfasdf sadfsadf
Address sadfas sdfsadfs
GradeA hhh lll
Address ppp hhh

This is what I have so far but this scrip does not loop. It only copies first found entry.

Sub testme()
Dim FoundCell As Range

With Worksheets("Sheet1")
Set FoundCell = .Cells.Find(What:="*GradeA*", _
After:=.Cells(.Cells.Count), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
End With

If FoundCell Is Nothing Then
MsgBox "Not found"
Else
FoundCell.Resize(2, 1).EntireRow.Copy
Sheet2.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End If
End Sub


See More: If rows contains specific word, copy next two rows

Report •


#1
June 4, 2012 at 15:08:13

Please click on the blue line at the end of this post and read the instructions on how to post example data and VBA code in this forum.

After you've read the instructions, please repost your data and code.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
June 5, 2012 at 05:52:36
DerbyDad03, sorry about that.

I am really new with VBS and need help.
I have sheet1 and sheet2. All my raw data is in sheet1 column A and sheet2 will be summary report. I want my script to search each cell in column A and search for "Grade A". If find, copy entired row which contains Grade A word and also copy next row and paste it in sheet2. Here is an example.
Sheet1:

A              B                 C                
GradeA     sdfasdf        sadfsadf
Address    sadfas         sdfsadfs   
Grade B    sadfsd         dgfdsgdf
Address    sdfasf          ertertewt
Grade C    fhgfdgh        ukjtyuyt
GradeA     hhh             lll
Address    ppp             hhh

Sheet2 shoud look like this after running script.

A              B                 C                
GradeA     sdfasdf        sadfsadf
Address    sadfas         sdfsadfs 
GradeA     hhh             lll
Address    ppp         hhh


This is what I have so far but this scrip does not loop. It only copies first found entry.
Sub testme()
Dim FoundCell As Range

With Worksheets("Sheet1")
Set FoundCell = .Cells.Find(What:="*GradeA*", _
After:=.Cells(.Cells.Count), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
End With

If FoundCell Is Nothing Then
MsgBox "Not found"
Else
FoundCell.Resize(2, 1).EntireRow.Copy
        Sheet2.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End If
End Sub



Report •

#3
June 5, 2012 at 12:42:11
For some reason, known only to the folks at MS, they took this great example of how to use the .Find and .FindNext methods in VBA out of the Help files. It appears in 2003 and earlier, but not in any of the later versions.

Example
This example finds all cells in the range A1:A500 on worksheet one that contain 
the value 2 and changes it to 5.

With Worksheets(1).Range("a1:a500")
    Set c = .Find(2, lookin:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Value = 5
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

If you modify that example, you'll have taken care of the Find and Copy tasks, but your code is going to keep pasting the Rows into A1, since that address is a hardcoded range.

You need a way to find the next empty Row in the destination worksheet so that each Paste ends up under the existing data instead of overwriting it.

See Response # 1 of this thread for some code to find the next empty Row in the destination sheet and use that Row Number to set a new Paste location each time through the loop.

http://www.computing.net/answers/of...

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

Related Solutions


Ask Question