CODEWITHSUNDEEP
vbaexcel
sagittarius_88
sagittarius_88

Reputation: 59

VBA Macro to count minutes

I was wondering if it would be feasible to do the task I'm about to explain via VBA or not. Basically what I'm trying to do is, go through "DUMMY2" and once the values are "27", I would like to subtract the beginning and end of the "DATETIME" in that range to get the minute count

For example: 05/16/2018 11:05 - 05/16/2018 10:50 --> to get 15 minutes. And then continue to go through the list skipping "16" , "9", "4" and doing the until it hits the second batch of "27" and goes through the macro again to calculate the minute count.

Thank you very much!

Sub Test()

Cells.Find("DUMMY2").Offset(1, 0).Select
Do Until ActiveCell.Value = ""


Do While ActiveCell.Value > 26.8 And ActiveCell.Value < 27.1
First = ActiveCell.Offset(0, -2)
'maybe that doesn't make sense, but I'm trying to select the cells adjacent to "27"
ActiveCell.Offset(0, -2).Select
Loop
ActiveCell.Offset(1, 0).Select

Loop
End Sub

Data:

5/16/2018 10:35 -0.03   0
5/16/2018 10:40 -0.04   0
5/16/2018 10:45 -0.04   12
5/16/2018 10:50 -0.32   27
5/16/2018 10:55 -0.27   27
5/16/2018 11:00 -0.23   27
5/16/2018 11:05 -0.21   27
5/16/2018 11:10 -0.14   16
5/16/2018 11:15 -0.01   9
5/16/2018 11:20 -0.02   4
5/16/2018 11:25 -0.32   27
5/16/2018 11:30 -0.31   27
5/16/2018 11:35 -0.30   27
5/16/2018 11:40 -0.29   27

enter image description here

Upvotes: 3

Views: 429

Answers (1)

Hasib_Ibradzic
Hasib_Ibradzic

Reputation: 666

Here is something that works. You can update the hard coded column references to named ranges if you'd like

Sub cntDuration()


    Dim lRow As Long
    Dim intFlag As Integer
    Dim firstDate As Date, secondDate As Date
    Dim difTime As Long

    'Find the last non-blank cell in column A(1)
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    intFlag = 0

    For i = 2 To lRow
        If Sheets("Sheet1").Range("C" & i).Value > 26.8 And Sheets("Sheet1").Range("C" & i).Value < 27.1 Then
            If intFlag = 0 Then
                firstDate = Sheets("Sheet1").Range("A" & i).Value
                intFlag = 1
            Else
                If Sheets("Sheet1").Range("C" & i + 1).Value > 26.8 And Sheets("Sheet1").Range("C" & i + 1).Value < 27.1 Then

                Else
                    secondDate = Sheets("Sheet1").Range("A" & i).Value
                    difTime = DateDiff("n", firstDate, secondDate)
                    Sheets("Sheet1").Range("D" & i).Value = difTime
                    intFlag = 0
                End If
            End If
        End If
    Next i

End Sub

Basically the line of code that does what you are wanting is the difTime = DateDiff("n", firstDate, secondDate)

Upvotes: 2

Related Questions