Capturing Cell Values
 

I was given this snippet to scan a range for a unique text and then capture
the cell value. This has worked great. Now I would like to also capture the
cell value of the unique text string and the cell value of the next cell.
These values would be put into Worksheet 2 columns A & B. I am just not sure
how to move the cell capture.

Sub copyData()
Dim cell As Range, rw As Long
rw = 2
For Each cell In ActiveSheet.Range("A1:i9306") 'Range of InDesign
file
If InStr(1, cell, "CRG", vbTextCompare) Then 'Unique string
Worksheets("Sheet2").Cells(rw, 1).Value = cell.Value
rw = rw + 1
End If
Next
End Sub

Capturing Cell Values
 

Try adding the following code just below (Worksheets("Sheet2").Cells(rw,
1).Value = cell.Value).
Worksheets("Sheet2").Cells(rw, 2).Value = cell.offset(0,1).Value

HTH,
Paul

"Pablo" wrote in message
...
I was given this snippet to scan a range for a unique text and then capture
the cell value. This has worked great. Now I would like to also capture
the
cell value of the unique text string and the cell value of the next cell.
These values would be put into Worksheet 2 columns A & B. I am just not
sure
how to move the cell capture.

Sub copyData()
Dim cell As Range, rw As Long
rw = 2
For Each cell In ActiveSheet.Range("A1:i9306") 'Range of
InDesign
file
If InStr(1, cell, "CRG", vbTextCompare) Then 'Unique string
Worksheets("Sheet2").Cells(rw, 1).Value = cell.Value
rw = rw + 1
End If
Next
End Sub