Macro to look up data

[abberyfarm]

I am hoping somebody here could help me out with a macro to do a task that I have

In sheet 1, I have time values (Col A) and speed values (Col B).

In sheet 2, I have a start time (Col A), an end time (Col B) and in column C either numbers 1 and 2 which indicate a particular type of data.

Here is an example of sheet 1

      Time [sec]	 Speed
14/04/2011 07:40:35	 0
14/04/2011 07:40:36	 1
14/04/2011 07:40:37	 3
14/04/2011 07:40:38	 4
14/04/2011 07:40:39	 5
14/04/2011 07:40:40	 7
14/04/2011 07:40:41	 8
14/04/2011 07:40:42	 9
14/04/2011 07:40:43	 10
14/04/2011 07:40:44	 10
14/04/2011 07:40:45	 11
14/04/2011 07:40:46	 12
14/04/2011 07:40:47	 12
14/04/2011 07:40:48	 13
14/04/2011 07:40:49	 14
14/04/2011 07:40:50	 15
14/04/2011 07:40:51	 3.8
14/04/2011 07:40:52	 7.5

And of sheet 2

Start Time [sec]	   End Time [sec]       Type
14/04/2011 07:40:35	14/04/2011 07:41:05	 1
14/04/2011 07:41:06	14/04/2011 07:41:36	 1
14/04/2011 07:41:37	14/04/2011 07:42:07	 2
14/04/2011 07:42:08	14/04/2011 07:42:38	 1
14/04/2011 07:42:39	14/04/2011 07:43:09	 2
14/04/2011 07:43:10	14/04/2011 07:43:40	 2
14/04/2011 07:43:41	14/04/2011 07:44:11	 2
14/04/2011 07:44:12	14/04/2011 07:44:42	 2
14/04/2011 07:44:43	14/04/2011 07:45:13	 1
14/04/2011 07:45:14	14/04/2011 07:45:44	 1
14/04/2011 07:45:45	14/04/2011 07:46:15	 2
14/04/2011 07:46:16	14/04/2011 07:46:46	 1
14/04/2011 07:46:47	14/04/2011 07:47:17	 2
14/04/2011 07:47:18	14/04/2011 07:47:48	 2
14/04/2011 07:47:49	14/04/2011 07:48:19	 1
14/04/2011 07:48:20	14/04/2011 07:48:50	 1
14/04/2011 07:48:51	14/04/2011 07:49:21	 1

What I would like to do is,

In sheet 2, check the value in each row of column C. If the value equals 1, then go back to sheet 1 and copy all the data in column B to a new sheet between the start and end time.

I've attempted the code, but I am not sure how to take the start and end times in sheet 2 and look up and select the range in sheet 1.

m = 1

Worksheets("sheet2").Range("c2").Select

Do

        If (ActiveCell.Value = 1) Then

        'Take start and end times and look up range of values in sheet 1 
       
        End If

    ActiveCell.Offset(1, 0).Select

    Loop Until IsEmpty(ActiveCell.Offset(0, -1))

 

[venkat1926]

try this macro and check whether it works

Sub test()
Dim r As Range, filt As Range, cfilt As Range
Dim r1 As Range, c1 As Range, t1, t2
Worksheets("sheet2").Activate
ActiveSheet.AutoFilterMode = False
Worksheets("sheet3").Cells.Clear
With Worksheets("Sheet2")
Set r = .Range("A1").CurrentRegion
'MsgBox r.Address
r.Sort key1:=Range("C1"), header:=xlYes
r.AutoFilter field:=3, Criteria1:="1"
Set filt = r.Offset(1, 0).Resize(r.Rows.Count - 1, r.Columns.Count).SpecialCells(xlCellTypeVisible)
Set filt = filt.Columns("A:A")
For Each cfilt In filt.Cells
t1 = cfilt.Value
t2 = cfilt.Offset(0, 1).Value
With Worksheets("sheet1")
Set r1 = Range(.Range("A2"), .Range("A2").End(xlDown))
For Each c1 In r1
If c1 >= t1 And c1 <= t2 Then
c1.EntireRow.Copy
Worksheets("sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next c1
End With
Next cfilt
filter:
r.AutoFilter
End With
End Sub

 

[abberyfarm]

Hi thank you for replying, I've tried your code and it works perfectly for what I asked above. Would it be possible to make a slight modification? What I would like it to do is when a segment of data is copied into sheet 3, could it save the sheet to a folder, then clear sheet 3 again and then copy in the next segment of data and save that sheet to and so on. The idea would be that I would have individual files in folder containing the segments of data. The files could be given any name.

That would be a great help

Ash

 

[venkat1926]

slightly modified "test" and added a new macro
clearing of workhsheets("sheet3" is already in the mcro "test" itself

Sub test()
Dim r As Range, filt As Range, cfilt As Range
Dim r1 As Range, c1 As Range, t1, t2
Worksheets("sheet2").Activate
ActiveSheet.AutoFilterMode = False
[COLOR=Magenta]Worksheets("sheet3").Cells.Clear[/COLOR]
With Worksheets("Sheet2")
Set r = .Range("A1").CurrentRegion
'MsgBox r.Address
r.Sort key1:=Range("C1"), header:=xlYes
r.AutoFilter field:=3, Criteria1:="1"
Set filt = r.Offset(1, 0).Resize(r.Rows.Count - 1, r.Columns.Count).SpecialCells(xlCellTypeVisible)
Set filt = filt.Columns("A:A")
For Each cfilt In filt.Cells
t1 = cfilt.Value
t2 = cfilt.Offset(0, 1).Value
With Worksheets("sheet1")
Set r1 = Range(.Range("A2"), .Range("A2").End(xlDown))
For Each c1 In r1
If c1 >= t1 And c1 <= t2 Then
c1.EntireRow.Copy
Worksheets("sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next c1
End With
Next cfilt
filter:
r.AutoFilter
End With
[COLOR=Red]newfolder[/COLOR]
End Sub

Sub newfolder()
Dim nameoffile As String

Worksheets("sheet3").Activate
ActiveSheet.Copy
nameoffile = InputBox("type the fiel name you want")
ActiveWorkbook.SaveAs nameoffile
ThisWorkbook.Activate
End Sub

 

[abberyfarm]

Hi just realized that I did not thank you for this.

Thank you!

 

[abberyfarm]

Hi venkat1926,

I am just looking back through code that you kindly wrote for me in August. I am wondering how do you change it if the "Type" values are in column BA instead of B and everything else is the same?

I've posted the code but something is going wrong?

I would appreciate any help.

Thank you

Sub test()
Dim r As Range, filt As Range, cfilt As Range
Dim r1 As Range, c1 As Range, t1, t2
Worksheets("sheet2").Activate
ActiveSheet.AutoFilterMode = False
Worksheets("sheet3").Cells.Clear
With Worksheets("Sheet2")
Set r = .Range("A1").CurrentRegion
'MsgBox r.Address
r.Sort key1:=Range("BA1"), Header:=xlYes
r.AutoFilter field:=53, Criteria1:="1"
Set filt = r.Offset(1, 0).Resize(r.Rows.Count - 1, r.Columns.Count).SpecialCells(xlCellTypeVisible)
Set filt = filt.Columns("A:A")
For Each cfilt In filt.Cells
t1 = cfilt.Value
t2 = cfilt.Offset(0, 52).Value
With Worksheets("sheet1")
Set r1 = Range(.Range("A2"), .Range("A2").End(xlDown))
For Each c1 In r1
If c1 >= t1 And c1 <= t2 Then
c1.EntireRow.Copy
Worksheets("sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next c1
End With
Next cfilt
filter:
r.AutoFilter
End With
End Sub

 

[venkat1926]

data in column B is cut and pasted in BA , is this in sheet 1 or sheetg 2 or in both

 

[abberyfarm]

Hi,

Sheet 1 is the same.

In Sheet 2, the data in Column C is now in Column BA. Columns A and B are still in same place.

Everything else the same.

Thank you

 

[venkat1926]

while modifying an old macro keep the message boxes operative.
see the statement

With Worksheets("Sheet2")
Set r = .Range("A1").CurrentRegion
MsgBox r.Address
r.Sort key1:=Range("BA1"), Header:=xlYes

currentregion takes into account contiguous filled colums and rows only and no blanks.
check what is the result of the msgbox r.address
I am also not clear if B col in col BA that too only in sheet 2 does it mean col B in this sheet is blank column.

i do not how you could post the configuration of the two sheets with so many coumns A to BA. think about it.

 

[abberyfarm]

This is what it looks like:


Here is an example of sheet 1

         Col A           Col B
      Time [sec] 	 Speed
14/04/2011 07:40:35	 0
14/04/2011 07:40:36	 1
14/04/2011 07:40:37	 3
14/04/2011 07:40:38	 4
14/04/2011 07:40:39	 5
14/04/2011 07:40:40	 7
14/04/2011 07:40:41	 8
14/04/2011 07:40:42	 9
14/04/2011 07:40:43	 10
14/04/2011 07:40:44	 10
14/04/2011 07:40:45	 11
14/04/2011 07:40:46	 12
14/04/2011 07:40:47	 12
14/04/2011 07:40:48	 13
14/04/2011 07:40:49	 14
14/04/2011 07:40:50	 15
14/04/2011 07:40:51	 3.8
14/04/2011 07:40:52	 7.5

And of sheet 2

      Col A                     Col B            Col BA
Start Time [sec]	   End Time [sec]       Type
14/04/2011 07:40:35	14/04/2011 07:41:05	 1
14/04/2011 07:41:06	14/04/2011 07:41:36	 1
14/04/2011 07:41:37	14/04/2011 07:42:07	 2
14/04/2011 07:42:08	14/04/2011 07:42:38	 1
14/04/2011 07:42:39	14/04/2011 07:43:09	 2
14/04/2011 07:43:10	14/04/2011 07:43:40	 2
14/04/2011 07:43:41	14/04/2011 07:44:11	 2
14/04/2011 07:44:12	14/04/2011 07:44:42	 2
14/04/2011 07:44:43	14/04/2011 07:45:13	 1
14/04/2011 07:45:14	14/04/2011 07:45:44	 1
14/04/2011 07:45:45	14/04/2011 07:46:15	 2
14/04/2011 07:46:16	14/04/2011 07:46:46	 1
14/04/2011 07:46:47	14/04/2011 07:47:17	 2
14/04/2011 07:47:18	14/04/2011 07:47:48	 2
14/04/2011 07:47:49	14/04/2011 07:48:19	 1
14/04/2011 07:48:20	14/04/2011 07:48:50	 1
14/04/2011 07:48:51	14/04/2011 07:49:21	 1

In sheet 2, there is data between column B and column BA.

thank you