excel , extract the time Break from one cell in excel sheet? - vba

Question

I have an Excel sheet like below and I need only the three "Break" times even if it meant to delete every thing except those three Breaks in every cell.
Function GetBreaksTime(txt As String)
Dim i As Long
Dim arr As Variant
arr = Split(txt, "Break")
If UBound(arr) > 0 Then
ReDim startTimes(1 To UBound(arr)) As String
For i = 1 To UBound(arr)
startTimes(i) = WorksheetFunction.Trim(Replace(Split(arr(i), "-")(0), vbLf, ""))
Next
GetBreaksTime = startTimes
End If
End Function
This what I got until now but it wont work on every cell and it takes wrong values.
So any idea how to do this?

Answer 1

If you split the cell value by vbLf the break time will always follow a line containing "Break".
The following should work:
Sub TestGetBreakTimes()
Dim CellValue As String
CellValue = Worksheets("Sheet1").Range("A1").Value
Dim BreakTimes As Variant
BreakTimes = GetBreakTimes(CellValue)
Debug.Print Join(BreakTimes, vbLf) 'the join is just to output the array at once.
'to output in different cells loop through the array
Dim i As Long
For i = 0 To UBound(BreakTimes)
Cells(3 + i, "A") = BreakTimes(i)
Next i
'or for a even faster output use
Range("A3").Resize(UBound(BreakTimes) + 1).Value = WorksheetFunction.Transpose(BreakTimes)
End Sub
Function GetBreakTimes(InputData As String) As Variant
Dim BreakTimes() As Variant
ReDim BreakTimes(0)
Dim SplitArr As Variant
SplitArr = Split(InputData, vbLf) 'split by line break
If UBound(SplitArr) > 0 Then
Dim i As Long
For i = 0 To UBound(SplitArr)
If SplitArr(i) = "Break" Then 'if line contains break then next line is the time of the break
If BreakTimes(0) <> vbNullString Then ReDim Preserve BreakTimes(UBound(BreakTimes) + 1)
BreakTimes(UBound(BreakTimes)) = SplitArr(i - 1) 'collect break time
End If
Next i
GetBreakTimes = BreakTimes
End If
End Function
To analyze a complete range you must loop through your row 2
Sub GetAllBreakTimes()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastCol As Long
LastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
Dim BreakTimes As Variant
Dim iCol As Long
For iCol = 1 To LastCol
BreakTimes = GetBreakTimes(ws.Cells(2, iCol).Value)
ws.Cells(3, iCol).Resize(UBound(BreakTimes) + 1).Value = WorksheetFunction.Transpose(BreakTimes)
Next iCol
End Sub