Excel/VBA find string and copy offset cells

Question

I'm in need of a small piece of VBA to do the following, search for a particular string, for instance ("New Applications"), and then copy the cells offset (0,2) and (0,5). Hence if "New Applications" is found in A34, I then need to copy D34 and J34…

Any help, much appreciated.

All I have so far is as below, but i'm sure how to also copy offset(0,5)..

Sub test()
Cells.Find(What:="NB ASDA Applications", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
    xlNext, MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, 2).Select
    Selection.Copy

The rest of the code, re pasting etc I already have, I just need to amend a small part to something like above.

many thanks

Answer 1

In this case it would greatly help to use a variable.

Sub test()
    'make a variable called foundrange that is of type "Range"
    Dim foundRange as Range

    'set this variable based on what is found: (note we remove the 'activate' here
    Set foundRange = Cells.Find(What:="NB ASDA Applications", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False)

    'You can copy now and do whatever you want. Say you want to copy these values to Sheet2!A1 and B1, respectively:
    Sheet2.Range("A1").Value = foundRange.OFfset(0,2).value
    Sheet2.Range("B1").Value = foundRange.Offset(0,5).value 

    'Or copy to the clipboard -- haven't tested this union, but I think it should work
    Union(foundRange.Offset(0,2), foundRange.Offset(0,5)).Copy  

    'Or copy just one and do something
    foundRange.Offset(0,2).Copy
    'do something

    'Copy the other one and do something
    foundRange.Offset(0,5).Copy
    'do something