Looping for time gaps and copying to another worksheet

Question

I have a list of times like this:

Start time  End Time        Difference between times
10:31:53    10:34:40        0.000115741
10:34:50    10:35:21        0.000196759
10:35:38    10:37:17        0.000138889
10:37:29    10:37:52        0.000358796
10:38:23    10:40:01        0.000324074
10:40:29    10:40:59        4.62963E-05
10:41:03    10:41:46        0.000173611
10:42:01    10:42:33        0.000104167

I am trying to set up VBA that finds differences that are greater than 40 minutes (0.02777778) and once it finds it it copies the start and end times. There may be more than one gap time that is greater than 40 minutes so I would like to copy them all (preferably to the right apposed to vertically like a list).

Here is what I have so far:

Dim i As Range
For Each i In Range("F14:F30000").SpecialCells(xlCellTypeVisible)
    If i.Value > 0.02777778 Then
        i.Select
        Selection.Offset(, -2).Copy Destination:=Sheets("Time Gaps").Range("B3")
        i.Select
        Selection.Offset(1, -3).Copy Destination:=Sheets("Time Gaps").Range("D3")
    End If
Next i

But it only copies the last gap time that meets the criteria. How can I make it so it records all of them?

Thanks in advance!

Do you need to keep formatting? If you just need values, just set two ranges equal to eachother. ie: `Range([destination range]).Value = Range([copy from Range]).Value`. Also, it's best to [avoid using `.Select`/`.Activate`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros). — BruceWayne, Jan 11 '17 at 22:35
@BruceWayne Are you talking about the time gap itself? I am using that column as a reference but the start and end times that make up the difference is what I am really after. — DLem, Jan 11 '17 at 22:42

score 0 · Answer 1 · answered Jan 11 '17 at 22:45

The problem lies in that you always paste to B3/D3. To solve this you need to make the destination variable too. One way of doing this is to make a range variable which points to the destination cell and shift the reference each time a match is found, Start with;

Dim rDest as range
Set rDest = Sheets("Time Gaps").Range("D3") 'init reference

Then replace the copy line with;

Selection.Offset(, -2).Copy Destination:=rDest

You can use rDest.offset to make relative shifts to the destination cell.

And right before end if add the following line;

Set rDest = rDest.Offset(1,0) 'set range to next row

I added an answer to show my new formula. I like where you were going with this but can you help me out with the way I edited it? — DLem, Jan 12 '17 at 00:08

score 0 · Answer 2 · answered Jan 11 '17 at 22:47

You always copy your results to cells B3/D3 so all but the last result are overwritten.

Easiest way would probably be a counter that determines in what row the data are covered:

Dim i As Range
dim counter as Integer
For Each i In Range("F14:F30000").SpecialCells(xlCellTypeVisible)
    If i.Value > 0.02777778 Then
        i.Select
        Selection.Offset(, -2).Copy Destination:=Sheets("Time Gaps").Cells(counter + 3, 2)
        i.Select
        Selection.Offset(1, -3).Copy Destination:=Sheets("Time Gaps").Cells(counter + 3, 2)
        counter = counter + 1
    End If
Next i

score 0 · Answer 3 · answered Jan 12 '17 at 00:07

This is working pretty well. I added rDest2 because I wanted both the start time and end time copied to my "Time Gap" sheet. I am having issues though with how the second gap time found is pasting with the offset. this is my formula:

Dim i As Range
Dim rDest As Range
Dim rDest2 As Range
Set rDest = Sheets("Time Gaps").Range("B3")
Set rDest2 = Sheets("Time Gaps").Range("D3")
For Each i In Range("F14:F30000").SpecialCells(xlCellTypeVisible)
    If i.Value > 0.02777778 Then
        i.Select
        Selection.Offset(, -2).Copy Destination:=rDest
        i.Select
        Selection.Offset(1, -3).Copy Destination:=rDest2
        Set rDest = rDest.Offset(0, 4)
        Set rDest2 = rDest.Offset(0, 4)
    End If
Next i

The Time Gaps sheet I am trying to post to has header that look like this:

(Time Start) (Time Gap) (Time End) (Time Start) (Time Gap) (Time End)(Time Start) (Time Gap) (Time End)

Set rDest2 = rDest.Offset(0, 4) needed to be changed to Set rDest2 = rDest2.Offset(0, 4) — DLem, Jan 12 '17 at 00:21

score 0 · Answer 4 · answered Jan 12 '17 at 18:23

Looks like you offset by 4 columns, while your header repeats in sets of 3. You probably need to Offset(0,3). Also take a look at DLem's comment.

PS: You don't need to declare another variable rDest2, try;

    i.Offset(, -2).Copy Destination:=rDest
    i.Offset(1, -3).Copy Destination:=rDest.offset(0,1) 'or (0,2) if the 2nd item has to be 2 columns to the right

PS2: Please update the topic start instead of posting a new question as an answer (there is an edit link underneath your post)

Looping for time gaps and copying to another worksheet

4 Answers4