VBA to Create Rows based on date differences

[meshio123]

Hi All,

Hopefully a very simple query - which maybe covered within the forum - yet can't find or pinpoint what the search criteria would be to locate it.

Simple four column spreadsheet all unique, the last three columns are start date, end date, variance (the other one is name)

I'd like a macro to create a row for each record for the number of days difference in the variance and include a date column for the unique day (if that makes sense) example below;


NAME | START DATE | END DATE | VARIANCE
Person 1 | 01/04/18 | 05/04/18 | 4

I'd like it to be
NAME | START DATE | END DATE | DATE | VARIANCE
Person 1 | 01/04/18 | 05/04/18 | 01/04/18 | 4
Person 1 | 01/04/18 | 05/04/18 | 02/04/18 | 4
Person 1 | 01/04/18 | 05/04/18 | 03/04/18 | 4
Person 1 | 01/04/18 | 05/04/18 | 04/04/18 | 4

is this even possible in excel? I'm guessing it is as I've seen some real amazing stuff happen

Thank you for your time in reading this and offering support - much appreciated!

 

[Joe4]

Are you looking for it to update the current list where it currently resides (meaning it will need to add the DATE column to the current list), or do you want it to create a new list on a new sheet?

 

[Fluff]

How about

Sub AddRows()

   Dim i As Long
   Dim Qty As Long
      
   Columns(4).Insert
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Qty = Range("E" & i).Value
      If Qty > 1 Then
         Rows(i + 1).Resize(Qty - 1).Insert
         Range("A" & i).Resize(Qty, 5).FillDown
         Range("D" & i).Value = Range("B" & i).Value
         Range("D" & i).AutoFill Range("D" & i).Resize(Qty), xlFillDays
      Else
         Range("D" & i).Value = Range("B" & i).Value
      End If
   Next i
         
End Sub

 

[meshio123]

How about

Sub AddRows()

   Dim i As Long
   Dim Qty As Long
      
   Columns(4).Insert
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Qty = Range("E" & i).Value
      If Qty > 1 Then
         Rows(i + 1).Resize(Qty - 1).Insert
         Range("A" & i).Resize(Qty, 5).FillDown
         Range("D" & i).Value = Range("B" & i).Value
         Range("D" & i).AutoFill Range("D" & i).Resize(Qty), xlFillDays
      Else
         Range("D" & i).Value = Range("B" & i).Value
      End If
   Next i
         
End Sub

Thank you Joe and Fluff for your very quick responces!

Fluff - that works a treat! many thanks for this

 

[Fluff]

Glad we could help & thanks for the feedback