abberyfarm
Well-known Member
- Joined
- Aug 14, 2011
- Messages
- 733
I am hoping somebody here could help me out with a macro to do a task that I have.
The macro is nearly working, it just needs a bit of tweaking and I'm struggling with it.
Here is what 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
And of sheet 2
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.
Then when a segment of data is copied into sheet 3, I need it to 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 between the start and end times. The files could be given any name.
But what is actually happening is that all the data for a particular type (i.e Type 1) is being copied into sheet 3 all at once, instead of individually.
I would greatly appreciate any help.
The macro is nearly working, it just needs a bit of tweaking and I'm struggling with it.
Here is what 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
Code:
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
Code:
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.
Then when a segment of data is copied into sheet 3, I need it to 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 between the start and end times. The files could be given any name.
But what is actually happening is that all the data for a particular type (i.e Type 1) is being copied into sheet 3 all at once, instead of individually.
I would greatly appreciate any help.
Code:
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