Split Time Range into Half Hour Each Row

D

disyn

New Member
Joined
Apr 24, 2020
Messages
17
Office Version
  1. 365
Platform
  1. Windows
I have a data set that look like this

NameActivityDetailStartFinish
BobCookingCooking pasta22/04/2020 9:0022/04/2020 10:00
BillReadingReading novel22/04/2020 9:3022/04/2020 10:00

And i want to split it like this

NameTimeActivityDetail
Bob22/04/2020 9:00CookingCooking pasta
Bob22/04/2020 9:30CookingCooking pasta
Bill22/04/2020 9:30ReadingReading Novel

Any excel formula idea or vba macro code idea? Thank you!
 
Sort by date Sort by votes
Try this, results in S2 onwards.

VBA Code: 
Sub Split_Time()
  Dim i As Long, j As Long, k As Long, hrs As Double, med As Double
  Dim a As Variant, b As Variant
  a = Range("G2:Q" & Range("G" & Rows.Count).End(3).Row).Value2
  ReDim b(1 To UBound(a) * 24, 1 To 5)
  For i = 1 To UBound(a)
    If IsNumeric(a(i, 11)) And IsNumeric(a(i, 10)) Then
      hrs = Round((a(i, 11) - a(i, 10)) * 48, 0)
      med = 0
      For j = 1 To hrs
        k = k + 1
        b(k, 1) = a(i, 1)
        b(k, 2) = a(i, 10) + med
        b(k, 3) = a(i, 2)
        b(k, 4) = a(i, 3)
        b(k, 5) = a(i, 4)
        med = j / 48
      Next
    End If
  Next
  Range("S2").Resize(k, 5).Value = b
End Sub
 
Upvote 0

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
DanteAmor said:
Try this, results in S2 onwards.

VBA Code: 
Sub Split_Time()
  Dim i As Long, j As Long, k As Long, hrs As Double, med As Double
  Dim a As Variant, b As Variant
  a = Range("G2:Q" & Range("G" & Rows.Count).End(3).Row).Value2
  ReDim b(1 To UBound(a) * 24, 1 To 5)
  For i = 1 To UBound(a)
    If IsNumeric(a(i, 11)) And IsNumeric(a(i, 10)) Then
      hrs = Round((a(i, 11) - a(i, 10)) * 48, 0)
      med = 0
      For j = 1 To hrs
        k = k + 1
        b(k, 1) = a(i, 1)
        b(k, 2) = a(i, 10) + med
        b(k, 3) = a(i, 2)
        b(k, 4) = a(i, 3)
        b(k, 5) = a(i, 4)
        med = j / 48
      Next
    End If
  Next
  Range("S2").Resize(k, 5).Value = b
End Sub
Click to expand...
i have tried but it showed runtime error 1004, application defined or object defined error, do i need to add something on range S2 or any idea why does this error happen?
 
Upvote 0
Which line of the macro does it stop at?
Are the data really as you put them in post #10?
 
Upvote 0
Change the formulas for these and then try the macro

varios 27abr2020.xlsm
GHIJKLMNOPQ
1Activity NoUserActivityDescriptionDayMonthYearStart TimeEnd TimeDate StartDate End
2A-1Staff 3testtest56202009:00:00 a.m.10:00:00 a.m.05/06/2020 09:0005/06/2020 10:00
3A-2Staff 4test1test148202008:30:00 a.m.09:30:00 a.m.04/08/2020 08:3004/08/2020 09:30
Hoja16
Cell Formulas
RangeFormula
P2:Q3P2=(TEXT(DATE($M2,$L2,$K2),"dd/mm/yyyy ")&TEXT(N2,"hh:mm"))+0
 
Upvote 0
i
DanteAmor said:
Change the formulas for these and then try the macro

varios 27abr2020.xlsm
GHIJKLMNOPQ
1Activity NoUserActivityDescriptionDayMonthYearStart TimeEnd TimeDate StartDate End
2A-1Staff 3testtest56202009:00:00 a.m.10:00:00 a.m.05/06/2020 09:0005/06/2020 10:00
3A-2Staff 4test1test148202008:30:00 a.m.09:30:00 a.m.04/08/2020 08:3004/08/2020 09:30
Hoja16
Cell Formulas
RangeFormula
P2:Q3P2=(TEXT(DATE($M2,$L2,$K2),"dd/mm/yyyy ")&TEXT(N2,"hh:mm"))+0
Click to expand...
finally the code is working, but it only run for data in first row. Would you please help me so it also runs for the data in second, third, and nth row?
 
Upvote 0
Are you testing with the example you set?

Try now with this one:

VBA Code: 
Sub Split_Time()
  Dim i As Long, j As Long, k As Long, hrs As Double, med As Double
  Dim a As Variant, b As Variant, lr As Long
  lr = ActiveSheet.Range("P:P").Find("*", , xlValues, , xlByRows, xlPrevious).Row
  a = Range("G2:Q" & lr).Value2
  ReDim b(1 To UBound(a) * 24, 1 To 5)
  For i = 1 To UBound(a)
    If IsNumeric(a(i, 11)) And IsNumeric(a(i, 10)) Then
      hrs = Round((a(i, 11) - a(i, 10)) * 48, 0)
      med = 0
      For j = 1 To hrs
        k = k + 1
        b(k, 1) = a(i, 1)
        b(k, 2) = a(i, 10) + med
        b(k, 3) = a(i, 2)
        b(k, 4) = a(i, 3)
        b(k, 5) = a(i, 4)
        med = j / 48
      Next
    End If
  Next
  Range("S2").Resize(k, 5).Value = b
End Sub
 
Upvote 0
DanteAmor said:
Are you testing with the example you set?

Try now with this one:

VBA Code: 
Sub Split_Time()
  Dim i As Long, j As Long, k As Long, hrs As Double, med As Double
  Dim a As Variant, b As Variant, lr As Long
  lr = ActiveSheet.Range("P:P").Find("*", , xlValues, , xlByRows, xlPrevious).Row
  a = Range("G2:Q" & lr).Value2
  ReDim b(1 To UBound(a) * 24, 1 To 5)
  For i = 1 To UBound(a)
    If IsNumeric(a(i, 11)) And IsNumeric(a(i, 10)) Then
      hrs = Round((a(i, 11) - a(i, 10)) * 48, 0)
      med = 0
      For j = 1 To hrs
        k = k + 1
        b(k, 1) = a(i, 1)
        b(k, 2) = a(i, 10) + med
        b(k, 3) = a(i, 2)
        b(k, 4) = a(i, 3)
        b(k, 5) = a(i, 4)
        med = j / 48
      Next
    End If
  Next
  Range("S2").Resize(k, 5).Value = b
End Sub
Click to expand...
thank you so much, it works with the data i provided. but when i tried to input data from userform (the inputted data will appear on the table i have given), it shows error.
 
Last edited by a moderator:
Upvote 0
Do you have a code that puts the userform data to the sheet?
Put that code here to review it.
 
Upvote 0
DanteAmor said:
Do you have a code that puts the userform data to the sheet?
Put that code here to review it.
Click to expand...
VBA Code: 
Private Sub ComboBox1_Change() 'for staff

End Sub

Private Sub ComboBox2_Change() 'for day

End Sub

Private Sub ComboBox3_Change() 'for month

End Sub

Private Sub ComboBox4_Change() 'for year

End Sub

Private Sub ComboBox5_Change()
   ComboBox5.value = Format(ComboBox5, "hh:mm")
End Sub

Private Sub ComboBox8_Change()
    ComboBox8.value = Format(ComboBox8, "hh:mm")
End Sub

Private Sub CommandButton1_Click() 'cancel button

Unload Me

End Sub

Private Sub CommandButton3_Click() 'submit button

Sheet6.ListObjects("Tabel_Activity").ListRows.Add AlwaysInsert:=True

Dim indeks As Integer
indeks = Sheet6.ListObjects("Tabel_Activity").ListRows.Count
Sheet6.ListObjects("Tabel_Activity").Range.Cells(indeks + 1, 1) = "A-" & indeks
Sheet6.ListObjects("Tabel_Activity").Range.Cells(indeks + 1, 2) = ComboBox1.value
Sheet6.ListObjects("Tabel_Activity").Range.Cells(indeks + 1, 3) = TextBox1.value
Sheet6.ListObjects("Tabel_Activity").Range.Cells(indeks + 1, 4) = TextBox2.value
Sheet6.ListObjects("Tabel_Activity").Range.Cells(indeks + 1, 5) = ComboBox2.value
Sheet6.ListObjects("Tabel_Activity").Range.Cells(indeks + 1, 6) = ComboBox3.value
Sheet6.ListObjects("Tabel_Activity").Range.Cells(indeks + 1, 7) = ComboBox4.value
Sheet6.ListObjects("Tabel_Activity").Range.Cells(indeks + 1, 8) = ComboBox5.value
Sheet6.ListObjects("Tabel_Activity").Range.Cells(indeks + 1, 9) = ComboBox8.value

Unload Me

End Sub

Private Sub CommandButton4_Click() 'reset button

ComboBox1.value = ""
TextBox1.value = ""
TextBox2.value = ""
ComboBox2.value = ""
ComboBox3.value = ""
ComboBox4.value = ""
ComboBox5.value = ""
ComboBox8.value = ""
 
End Sub

And the userform itself look like this
1588045591580.png
 
Upvote 0
Replace formulas

varios 27abr2020.xlsm
GHIJKLMNOPQ
1Activity NoUserActivityDescriptionDayMonthYearStart TimeEnd TimeDate StartDate End
2A-1Staff 3testtest56202009:00:00 a.m.10:00:00 a.m.05/06/2020 09:0005/06/2020 10:00
3A-2Staff 4test1test148202008:30:00 a.m.09:30:00 a.m.04/08/2020 08:3004/08/2020 09:30
Sheet6
Cell Formulas
RangeFormula
P2:P3P2=(TEXT(DATE([Year],[Month],[Day]),"dd/mm/yyyy ")&TEXT([Start Time],"hh:mm"))+0
Q2:Q3Q2=(TEXT(DATE([Year],[Month],[Day]),"dd/mm/yyyy ")&TEXT([End Time],"hh:mm"))+0


Use this code in userform:

VBA Code: 
Private Sub CommandButton3_Click() 'submit button
  Dim indeks As Integer
  With Sheet6.ListObjects("Tabel_Activity")
    .ListRows.Add AlwaysInsert:=True
    indeks = .ListRows.Count + 1
    .Range.Cells(indeks, 1) = "A-" & indeks
    .Range.Cells(indeks, 2) = ComboBox1.Value
    .Range.Cells(indeks, 3) = TextBox1.Value
    .Range.Cells(indeks, 4) = TextBox2.Value
    .Range.Cells(indeks, 5) = Val(ComboBox2.Value)  'day
    .Range.Cells(indeks, 6) = Val(ComboBox3.Value)  'month
    .Range.Cells(indeks, 7) = Val(ComboBox4.Value)  'year
    .Range.Cells(indeks, 8) = ComboBox5.Value       'start
    .Range.Cells(indeks, 9) = ComboBox8.Value       'end
  End With
  Unload Me
End Sub

Try again
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
Formula help needed for working with days and times.
Replies
0
Views
423
dshtesy
D
O
  • Solved
VBA - Filter columns, cut/paste rows new sheet, pivot table
2
Replies
12
Views
315
Skyybot
Skyybot
T
  • Question Question
VBA help to count Daytime,Nighttime and Summary
2 3
Replies
20
Views
890
Alex Blakenburg
A
B
  • Solved
Sumifs Hours Worked Between Two Dates and Times with Multiple Criteria
2 3
Replies
24
Views
1K
Fluff
Fluff
AOB
  • Question Question
Calculate the "true" duration of up/down times accounting for gaps and overlaps
Replies
1
Views
718
AOB
AOB

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top