Creating a new row for each date within a row range

[sryan429]

Hi all!
Have a tricky one for you

I have a data set that contains multiple dates within each row, in the sample data the dates are published in C:E. The number of dates will vary from line to line. What I'd like to do is to create a NEW row for EACH of the dates, pasted as values, since the original rows will contain formulas. So customer 'a' would generate 3 new lines, 'b', 1 row, and 'c' 2 rows, as shown in the second image. Any help would be greatly appreciated!!


Raw Data

Desire Outcome

 

[LazyBug]

Hello!

How about

Sub srn()
Dim rng As Range, r&, c&, rc&, cc&
Dim i&, ii&, sh As Worksheet

Set rng = Range("A1").CurrentRegion: rc = rng.Rows.Count: cc = rng.Columns.Count
Set sh = Worksheets.Add: i = 1
For r = 2 To rc
    For c = 3 To cc
        If rng.Cells(r, c) <> "" Then
            For ii = 1 To 2
                sh.Cells(i, ii) = rng.Cells(r, ii)
            Next ii

            rng.Cells(r, c).Copy
            With sh.Cells(i, 3)
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
            End With
            i = i + 1
        End If
    Next c
Next r
End Sub

 

[alansidman]

Alternative solution with Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Date1", type date}, {"Date2", type date}, {"Date3", type date}}),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Customer", "Value"}, "Attribute", "Value.1"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Other Columns",{"Attribute"}),
    #"Renamed Columns" = Table.RenameColumns(#"Removed Columns",{{"Value.1", "Date1"}})
in
    #"Renamed Columns"

Book2
	A	B	C	D	E	F	G	H	I
1	Customer	Value	Date1	Date2	Date3		Customer	Value	Date1
2	a	10	7/1/2022	6/1/2022	6/1/2020		a	10	7/1/2022
3	b	50	12/1/2022				a	10	6/1/2022
4	c	40	1/1/2021	5/1/2022			a	10	6/1/2020
5							b	50	12/1/2022
6							c	40	1/1/2021
7							c	40	5/1/2022
Sheet1

 

[Fluff]

What version of Excel are you using?

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

 

[sryan429]

Hello!

How about

Sub srn()
Dim rng As Range, r&, c&, rc&, cc&
Dim i&, ii&, sh As Worksheet

Set rng = Range("A1").CurrentRegion: rc = rng.Rows.Count: cc = rng.Columns.Count
Set sh = Worksheets.Add: i = 1
For r = 2 To rc
    For c = 3 To cc
        If rng.Cells(r, c) <> "" Then
            For ii = 1 To 2
                sh.Cells(i, ii) = rng.Cells(r, ii)
            Next ii

            rng.Cells(r, c).Copy
            With sh.Cells(i, 3)
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
            End With
            i = i + 1
        End If
    Next c
Next r
End Sub

works perfectly, thanks for taking the time to put together!

 

[sryan429]

Alternative solution with Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Date1", type date}, {"Date2", type date}, {"Date3", type date}}),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Customer", "Value"}, "Attribute", "Value.1"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Other Columns",{"Attribute"}),
    #"Renamed Columns" = Table.RenameColumns(#"Removed Columns",{{"Value.1", "Date1"}})
in
    #"Renamed Columns"

Book2
	A	B	C	D	E	F	G	H	I
1	Customer	Value	Date1	Date2	Date3		Customer	Value	Date1
2	a	10	7/1/2022	6/1/2022	6/1/2020		a	10	7/1/2022
3	b	50	12/1/2022				a	10	6/1/2022
4	c	40	1/1/2021	5/1/2022			a	10	6/1/2020
5							b	50	12/1/2022
6							c	40	1/1/2021
7							c	40	5/1/2022
Sheet1

Thanks! My data has 10K+ rows, so this option was considerably quicker than VBA, didn't occur to me to use Power Query. Appreciate you giving the alternate solution!

 

[alansidman]

Thanks for the feedback and happy to help

 

[Fluff]

Thanks for updating your profile.
As you have xl365 here's a formula solution

=LET(a,Sheet1!A2:B10000,b,Sheet1!C2:E10000,c,COLUMNS(b),s,SEQUENCE(c*ROWS(b),,0),ax,INDEX(a,INT(s/c)+1,{1,2}),bx,INDEX(b,INT(s/c)+1,MOD(s,c)+1),FILTER(CHOOSE({1,2,3},ax,ax,bx),bx<>""))