VBA code to replicate rows for dates between and start and end date

[LDEWIT1970]

Hi there I need to replicate the dates between a start and end date range, in one row I have a column for start date and a column with an end date, I want to have the row with the same columns but with each date in that range in a row with the same information

Export sheet column sample :

Name	Start date	End Date	Type
Leeanne	01/01/2018	05/01/2018	Vacation

<tbody>
</tbody>

What I want it to look like :

Name	Start date	End Date	Type
Leeanne	01/01/2018	01/01/2018	Vacation
Leeanne	02/01/2018	02/01/2018	Vacation
Leeanne	03/01/2018	03/01/2018	Vacation
Leeanne	04/01/2018	04/01/2018	Vacation
Leeanne	05/01/2018	05/01/2018	Vacation

<tbody>
</tbody>

Thank you
Leeanne

 

[ParamRay]

Here's one way to do it:

Public Sub ExpandData()
' Assumes headers are in row 1
' and data begins in cell A2.
  
  Dim wksSource As Worksheet
  Dim wksTarget As Worksheet
  Dim intNumDays As Integer
  Dim lngLastRow As Long
  Dim avntData() As Variant
  Dim lngOldRows As Long
  Dim lngNewRows As Long
  Dim j As Long
  Dim k As Long

  Set wksSource = ThisWorkbook.Sheets("Data") '<-- change sheet name here
  Set wksTarget = ThisWorkbook.Sheets.Add
  wksTarget.Range("A1:D1").Value = wksSource.Range("A1:D1").Value
  lngLastRow = wksSource.Cells(wksSource.Rows.Count, "A").End(xlUp).Row
  
  For j = 2 To lngLastRow
    intNumDays = wksSource.Cells(j, "C").Value - wksSource.Cells(j, "B").Value + 1
    lngNewRows = lngOldRows + intNumDays
    ReDim Preserve avntData(1 To 4, 1 To lngNewRows)
    
    For k = lngOldRows + 1 To lngNewRows
      avntData(1, k) = wksSource.Cells(j, 1).Value
      avntData(2, k) = wksSource.Cells(j, 2).Value + k - lngOldRows - 1
      avntData(3, k) = avntData(2, k)
      avntData(4, k) = wksSource.Cells(j, 4).Value
    Next k
    
    lngOldRows = lngNewRows
  Next j
  
  wksTarget.Range("A2").Resize(lngNewRows, 4).Value = TransposeArray(avntData)
  wksTarget.Columns("A:D").AutoFit
End Sub

Private Function TransposeArray(avntSource() As Variant) As Variant()
  Dim lngLower1 As Long
  Dim lngLower2 As Long
  Dim lngUpper1 As Long
  Dim lngUpper2 As Long
  Dim j As Long
  Dim k As Long
  
  lngLower1 = LBound(avntSource, 1)
  lngLower2 = LBound(avntSource, 2)
  lngUpper1 = UBound(avntSource, 1)
  lngUpper2 = UBound(avntSource, 2)
  
  ReDim avntResult(lngLower2 To lngUpper2, lngLower1 To lngUpper1) As Variant
  For j = lngLower2 To lngUpper2
    For k = lngLower1 To lngUpper1
      avntResult(j, k) = avntSource(k, j)
    Next k
  Next j
  
  TransposeArray = avntResult
End Function

 

[LDEWIT1970]

Thank you very much it works perfectly.

I have more columns (A-I), I managed to see where to change some of the code to incorporate data until column I, but when I run the macro it only populates the column headers from E-I and not the data.

Thanks
Leanne