VBA code help

Occasional Contributor

Hi everyone, 


I currently have been working on this code:


Sub FindAndRecordGaps()

' 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

End If

' 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
wsNew.Range("D" & newRow).Value = stopRow - startRow
End If

' Reset the start and stop rows
startRow = 0
stopRow = 0

End If

Next i

' 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"

End Sub


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. 


Thank you in advance for any help!

0 Replies