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

LDEWIT1970

New Member
Joined
Feb 20, 2018
Messages
2
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 :

NameStart dateEnd DateType
Leeanne01/01/201805/01/2018Vacation

<tbody>
</tbody>


What I want it to look like :

NameStart dateEnd DateType
Leeanne01/01/201801/01/2018Vacation
Leeanne02/01/201802/01/2018Vacation
Leeanne03/01/201803/01/2018Vacation
Leeanne04/01/201804/01/2018Vacation
Leeanne05/01/201805/01/2018Vacation

<tbody>
</tbody>

Thank you
Leeanne
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Here's one way to do it:

Code:
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,916
Members
448,533
Latest member
thietbibeboiwasaco

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