' Define the worksheet that contains the data Dim wsData As Worksheet Set wsData = ActiveWorkbook.ActiveSheet
' Define the range that contains the data Dim lastRow As Long lastRow = wsData.Cells(Rows.Count, "A").End(xlUp).Row Dim dataRange As Range Set dataRange = wsData.Range("A33:E" & lastRow)
' Define the worksheet that will contain the table Dim wsNew As Worksheet Set wsNew = Sheets.Add(After:=Sheets(Sheets.Count)) wsNew.Name = "Data Summary"
' Set up the headers for the table wsNew.Range("A1:D1").Value = Array("Date", "Start Time", "Stop Time", "Gap")
' Loop through each row in the data range Dim i As Long Dim startRow As Long Dim stopRow As Long startRow = 0 stopRow = 0 For i = 1 To dataRange.Rows.Count
' Check if the value in column E is less than 10 If Not IsEmpty(dataRange(i, 5).Value) And dataRange(i, 5).Value < 10 Then
' Check if this is the first highlighted row If startRow = 0 Then startRow = i End If
' Set the stop row to the current row stopRow = i
' Check if the value in column E is greater than or equal to 10 or if this is the last row If (IsEmpty(dataRange(i, 5).Value) Or dataRange(i, 5).Value >= 10 Or i = dataRange.Rows.Count) And startRow > 0 Then
' Record the date, start time, stop time, and gap in the table Dim newRow As Long newRow = wsNew.Cells(Rows.Count, "A").End(xlUp).Row + 1 wsNew.Range("A" & newRow).Value = dataRange(startRow, 1).Value wsNew.Range("B" & newRow).Value = dataRange(startRow, 2).Value wsNew.Range("C" & newRow).Value = dataRange(stopRow, 2).Value If stopRow - startRow = 0 Then wsNew.Range("D" & newRow).Value = 0 Else wsNew.Range("D" & newRow).Value = stopRow - startRow End If
' Reset the start and stop rows startRow = 0 stopRow = 0
' Format the table wsNew.ListObjects.Add(xlSrcRange, wsNew.Range("A1:D" & wsNew.Cells(Rows.Count, "A").End(xlUp).Row), , xlYes).Name = "Data_Table" wsNew.ListObjects("Data_Table").TableStyle = "TableStyleMedium15"
This code does not include the blanks in the range known as gap, and I have to somehow include that so that in the "gap" column, only the blanks have "gap" in the column. This outputs my dates and start times correctly, but for the stop times, I need it to be the cell after it, so I would need to add +1. I'm not sure where I would make those changes. Can anyone help me with this?
I attached the Excel document. The Sauk_Tr tab shows the highlighted values, date and time I am working with in Columns A, B and E. The "info" tab shows the dates, start and end times along with gap written on the side that is needed. The "data summary" is the vba code output where the start time and dates are correct, but the stop times fall short of one. It also does not include the blanks or gaps that I need. The gap column also outputs values I'm unsure of. All I need is it to say "gap" or "yes" if that makes sense.