[Solved] Repeating Multiple Rows Multiple Times in Excel VBA, with Calculations [closed]

by


In my testing this does exactly what you asked for.

You will need to rename the Sheets depending on what your sheet names for the original data sheet name is and your output / result sheet name is.

 Option Explicit

 Sub splittinghours()

      Dim DataSheet As Worksheet
      Dim ResultSheet As Worksheet
      Set DataSheet = ThisWorkbook.Sheets("Sheet1")
      Set ResultSheet = ThisWorkbook.Sheets("Sheet2")

      Dim DataSheetLastRow As Long
      With DataSheet
          DataSheetLastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
      End With

      Dim ActualWarehouse As String
      Dim ActualDate As String
      Dim InTime As Date
      Dim OutTime As Date
      Dim Duration As Long
      Dim CurrentRow As Long
      Dim DurationCounter As Long
      Dim SegmentedDuration As Date
      Dim ResultSheetNextFreeLine As Long

      ResultSheet.Range(Cells(2, "A"), Cells(ResultSheet.Rows.Count, ResultSheet.Columns.Count)).Delete

      ResultSheetNextFreeLine = 0

      For CurrentRow = 2 To DataSheetLastRow

           ActualWarehouse = DataSheet.Cells(CurrentRow, "A").Value
           ActualDate = DataSheet.Cells(CurrentRow, "B").Value
           InTime = DataSheet.Cells(CurrentRow, "C").Value
           OutTime = DataSheet.Cells(CurrentRow, "D").Value
           Duration = DataSheet.Cells(CurrentRow, "E").Value
           SegmentedDuration = (OutTime - InTime) / Duration

           ResultSheetNextFreeLine = ResultSheet.Cells(ResultSheet.Rows.Count, "A").End(xlUp).Row

           For DurationCounter = 1 To Duration

                With ResultSheet

                    .Cells(ResultSheetNextFreeLine + DurationCounter, "A").Value = ActualWarehouse
                    .Cells(ResultSheetNextFreeLine + DurationCounter, "B").Value = ActualDate
                    .Cells(ResultSheetNextFreeLine + DurationCounter, "C").Value = InTime
                    .Cells(ResultSheetNextFreeLine + DurationCounter, "D").Value = InTime + SegmentedDuration
                     InTime = InTime + SegmentedDuration

                End With

           Next DurationCounter

      Next CurrentRow

 End Sub

2

solved Repeating Multiple Rows Multiple Times in Excel VBA, with Calculations [closed]