Copying data from one cell when other cell is between a time range

Hi all,

I am trying to copy a value in a cell based on the time stamp that is present in another cell.

For example, column A1:A288 has a time of 00:00 to 00:00 (5min increments) and Column B1:B288 has a range of data values.

I want to be able to copy say the values between 23:00 - 00:00 and paste them to another part of my work book.


I'm developing this so thought i'd start out simple and do one line to make sure the principle work fine then find a way to introduce a loop. The code I have is as follows (which doesn't work by the way):

Code:

---

Sub Macro2()'
' Macro2 Macro
'
    Range("A1").Select
   
If ActiveCell.Value => TIME(23, 0, 0) Then
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.Copy
    ActiveCell.Offset(0, 2).Range("A1").Select
    ActiveSheet.Paste
End If

---

The problem here is with line highlighted in bold. An error occurs and the code won't run any further. I know the code works past this line as I changed this to look at numbers and not times (code below) and then changed the column where the times were to all number 1s and the cell was copied.

Code:

---

Sub Macro2()'
' Macro2 Macro
'
    Range("A1").Select
   
If ActiveCell.Value >= 1 Then
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.Copy
    ActiveCell.Offset(0, 2).Range("A1").Select
    ActiveSheet.Paste
End If

---

I'm sure its my syntax to check the time of the cell as i have based this on the excel IF AND function syntax but alas, this was not the case.

Kind regards in advance

Paul

Manually copy one of the Time cells and Paste Special "Values" into a cell formatted as General or Number with 10 decimal places

Compare to (format C1 as number with 11 decimal places, then)

Code:

---

Sub Test()
Range("C1").Value = TimeSerial(23, 0, 0)
End Sub

---

Thanks SamT

The code as you have it works fine.

Just as an aside, ideally what I want to do is to check that a time is between two times say 23:00 - 07:00 and then copying that cell if it meets both these logical tests. I was trying to use an If And function but that does't seem to work either, any thoughts?

Code:

---

Sub Macro2()'
' Macro2 Macro
'
    Range("A1").Select
   
If  ActiveCell.Value => TimeSerial(23, 0, 0) And <= TimeSerial (07, 0, 0) Then
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.Copy
    ActiveCell.Offset(0, 2).Range("A1").Select
    ActiveSheet.Paste
End If


End Sub

---

Thanks

Paul

Forget that, i just had an epiphany! The code to do this is as follows:

Code:

---

Sub Macro2()'
' Macro2 Macro
'
    Range("A1").Select
   
If ActiveCell.Value >= TimeSerial(23, 0, 0) And ActiveCell.Value >= TimeSerial(7, 0, 0) Then
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.Copy
    ActiveCell.Offset(0, 2).Range("A1").Select
    ActiveSheet.Paste
End If


End Sub

---

Any idea how to loop this to keep going until it reaches a blank cell?

Code:

---

Option Explicit

Sub Macro2() '
'If Col A between times , then copy B to C

Dim StartTime As Double
Dim EndTime As Double
Dim r As Long

StartTime = TimeSerial(23, 0, 0)
EndTime = TimeSerial(7, 0, 0)

For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    With Cells(r, "A")
    If .Value >= StartTime And .Value <= EndTime Then _
        Cells(r, "C") = Cells(r, "B")
        'Alternate Cells(r, "B").Copy Cells(r, "C")
    End With
Next r
End Sub

---

Thanks Sam,

I came up with the following, which I think does the same job

Code:

---

Sub Macro2()'
' Macro2 Macro
'
    Range("A1").Select
   
Do Until IsEmpty(ActiveCell)


If ActiveCell.Value >= TimeSerial(23, 0, 0) And ActiveCell.Value >= TimeSerial(7, 0, 0) Then
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.Copy
    ActiveCell.Offset(0, 2).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(1, -3).Range("A1").Select
End If
Loop


End Sub

---

Although probably not as graceful as yours, although i've only been coding a few weeks and generally have no clue at all!

Hi again,

Further to the above discussion, I have some more issues that need resolving, mainly around the IF statement. What I am trying to do is tell the code to look at the cell, see if its after 23:00 and before 07:00 and if it is copy the cell next to it. I just can't resolve this logical test. Any help?

Code:

---

Sub Macro2()
'
' Macro2 Macro
'
Range("A1").Select

Do Until IsEmpty(ActiveCell)


If ActiveCell.Value > TimeSerial(23, 0, 0) Or ActiveCell.Value < TimeSerial(7, 0, 0) Then
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.Copy
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, -3).Range("A1").Select


Else
ActiveCell.Offset(1, 0).Range("A1").Select

End If
Loop
End Sub

---

Quote:

---

Further to the above discussion, I have some more issues that need resolving, mainly around the IF statement. What I am trying to do is tell the code to look at the cell, see if its after 23:00 and before 07:00 and if it is copy the cell next to it. I just can't resolve this logical test. Any help?

---

Code:

---

Sub Macro2() '
    'If Col A between times , then copy B to C
   
    Dim StartTime As Double
    Dim EndTime As Double
    Dim r As Long
   
    StartTime = TimeSerial(23, 0, 0)
    EndTime = TimeSerial(7, 0, 0)
   
    For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        With Cells(r, "A")
            If .Value >= StartTime And .Value <= EndTime Then _
            Cells(r, "C") = Cells(r, "B")
            'Alternate Cells(r, "B").Copy Cells(r, "C")
        End With
    Next r
End Sub

---

Quote:

---

although i've only been coding a few weeks and generally have no clue at all!

---

I've been doing this for 13 years.

Thanks again,

I've run that code and it I can step through it but it doesn't do anything to my data sheet. Do I have to modify this to fit it in my code to tell it where to point to?

It doesn't do anything at all? Where did you put the sub? If you put the sub in the WorkSheets' Code page it should work without any modification

You have another sub that this code is supposed to be part of?



You can enclose the For... Next loop in a With Sheets("Sheet?")... End With and it should work in the ThisWorkbook Code page or in a Module

And you can add .Value to the Cells(?, ?) assignments.