Return First and Last Value in a Subtotal Grouping

[garciaj50]

Team, first time user here, I've spent days looking for a solution to this, but I think I'm close but I'm simply running out of time to turn this project in. I am looking for a VBA code that will allow me to auto-populate the first value on the first empty cell of column A & the last value on the first empty cell of column B, and then those two values will be subtracted from each other, to fill the first empty cell of Column C all while maintaining a 'h:mm' format (Hour: Minute) format on a Subtotal Grouping, and auto-populate this all the way down until the last row.

As an example, I've filled the end result, so notice that cell A6 = the first value of the group, B6= the last value of the group, and C6 is the subtraction of those two , in H:MM format.

A	B	C
Start Time	Arrival Time	Dep Time
6:46 AM	7:00 AM	7:05 AM
7:05 AM	7:08 AM	8:08 AM
12:17 PM	12:18 PM	12:54 PM
6:46 AM	12:18 PM	5:32
Driver Started	Driver Finished	Total Time
7:27 AM	7:39 AM	7:31 AM
3:07 PM	3:17 PM	3:37 PM
Driver Started	Driver Finished	Total Time

<tbody>
</tbody>

I am getting stuck on how to write the VBA code to autofill these 3 columns all the way down to the last row, while taking under consideration that these are being separated by empty rows in between each other to allow for 2nd header & the formula that allows me to get my desiered result.

I am currently using this VBA for column A but i know this is not right since i'm declaring specific reference cells and obviously the report will always have more or less rows,

Sub TEST()
With Sheets("OKLAHOMA")
lr = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A2:A200" & lr).SpecialCells(xlBlanks).Formula = "=INDEX(A2:A200,MATCH(TRUE,INDEX((A2:A200<>0),0),0))"
End With
End Sub


Any help would be greatly appreciated, I've been using this forum for about 1 month or so and it's been extremely helpful but as I've mentioned I've spend days trying to figure this out and i can't seem to find anything. Thanks in advance!!

 

[theBardd]

Sub TEST()
Dim starttime As Double
Dim lr As Long
Dim i As Long
    With Sheets("OKLAHOMA")
    
        lr = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 1 To lr
        
            If .Cells(i, "A").Value = vbNullString Then
            
                .Cells(i, "A").Value = starttime
                .Cells(i, "B").Value = .Cells(i - 1, "B").Value
                .Cells(i, "C").Value = .Cells(i, "B").Value - .Cells(i, "A").Value
            ElseIf Application.IsText(.Cells(i, "A").Value) Then
            
                starttime = .Cells(i + 1, "A").Value
            End If
        Next i
    End With
End Sub

 

[DanteAmor]

Welcome to the forum

Try this:

Sub Return_Value()
    Dim c As Range
    For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp)(0)).SpecialCells(xlCellTypeConstants).Areas
        c.Cells(c.Rows.Count).Offset(1) = c.Cells(1).Offset(1)
        c.Cells(c.Rows.Count).Offset(1, 1) = c.Cells(c.Rows.Count).Offset(0, 1)
        c.Cells(c.Rows.Count).Offset(1, 2) = c.Cells(c.Rows.Count).Offset(1, 1) - c.Cells(c.Rows.Count).Offset(1)
    Next
End Sub

 

[Rick Rothstein]

Here is another macro that you can try...

Sub MinStartMaxArrival()
  Dim Ar As Range
  For Each Ar In Sheets("OKLAHOMA").Columns("A").SpecialCells(xlConstants).Areas
    If Ar.Count > 2 Then
      Ar(1).Offset(Ar.Count) = Application.Min(Ar)
      Ar(1).Offset(Ar.Count, 1) = Application.Max(Ar.Offset(, 1))
      Ar(1).Offset(Ar.Count, 2) = Ar(1).Offset(Ar.Count, 1) - Ar(1).Offset(Ar.Count)
      Ar(1).Offset(Ar.Count).Resize(, 2).NumberFormat = "h:mm AM/PM"
      Ar(1).Offset(Ar.Count, 2).NumberFormat = "h:mm"
    End If
  Next
End Sub

 

[garciaj50]

Wow, just...the speed of which i got a reply, the fact that it was EXACTLY what i needed, i am extremely impressed and very grateful, as i've mentioned i'm a brand new user and if this site gives kudos or if i can write any sort of review or give a "thumbs up" to you folks i'd be happy to, thank you thank you thank you!!!

 

[DanteAmor]

Im glad to help you. Thanks for the feedback.