Extract Data Code Modification Request

[joecrabtree]

To all,

I have the code shown below. It basically extracts data from one
workbook and dumps it into another workbook. It extracts the data
based on the 'res' condition. At the moment it searchs for one value
for 'res'. 'res' is a date. How do I modify the code to serach and
extract all the data based on a range of dates. For example res1 =
date1, and res2 = date2?

Thanks for your help on advance,

Regards,

Joseph Crabtreee

___________________________________________________


Set wbd = ThisWorkbook
Set wsd = wbd.Worksheets("DATA")
Set wbs = Workbooks.Open("\\s-ddideagen\dd-departments\Metallurgy\Kevin
\compile mech test results\all mechanical test results", , True) '<--
FILE NAME OF MECHANICAL TESTING FILE
Set wss = wbs.Worksheets("compiled results") ' <--- WORKSHEET WITH
DATA


row_d = 2 ' - defines starting row number


'Looks in column c, part number to find all cells CONTAINING value
res, returned above.

With Worksheets("compiled results").Range("C2:C65000")

Set c = .Find(res, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy wbd.Worksheets("DATA").Rows(row_d) ' data
is copied line by line into the current workbook

row_d = row_d + 1

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With




wbs.Close False
Set wss = Nothing
Set wbs = Nothing
Set wsd = Nothing
Set wbd = Nothing

 

[Bob Phillips]

You would need another loop

With Worksheets("compiled results").Range("C2:C65000")

For Each res In Worksheets("Data").Range("A2:A10")
Set c = .Find(res, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy wbd.Worksheets("DATA").Rows(row_d)
' data is copied line by line into the current workbook

row_d = row_d + 1

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Next res
End With