Code to Insert Rows below data with Specified Dates Based on Data in Another Column

[Ebonii]

Hi, I'm new so be gentle. This is a bit complex for me so I'm completely lost.


Below is an example of what I receive from our system, except imagine it about 200 columns across and up to 8,000 rows down. So manual manipulation is not only horrid but a risk of error.

Column's 'A' and 'B' are basic data. Column 'C' is the start date for the hours listed in Column's D-F. Columns D-F represent months that will go in order beginning with the date in column 'C'. So for instance in row 2, the start date is Dec-13, thus in row Month 1 is Dec-13, Month 2 would be Jan-14, and Month 3 would be Feb-2014. The logic continues for each row.

	A	B	C	D	E	F
1	ID	Group	Start Date	Month 1	Month 2	Month 3
2	Number 1	A.02	Dec-13	46	5	12
3	Number 2	A.04	Jan-14	16	25	1
4	Number 3	A.01	Sep-13	3	3	6

<TBODY>
</TBODY>

Below is what I need to get to with VBA code. (Ignore the font colors, they are just there for emphasis)

I need the code to go to another specified sheet, (let's assume the headers below are already there) and populate the data as you see it below.

1. I need each ID to have a row for the amount of months there are. (In this case 3 months, in my true case usually about 200 months.)
2. The ID is duplicated on each row
3. The corresponding group (column V is duplicated on each row
4. Column 'C' in the "first" row of each ID on the destination sheet (reference red rows) should have the corresponding start date as column 'C' on the originating sheet. (i.e. cell C2 below matches 'C2' on start sheet, cell 'C5' matches 'C3' and so on)
5. The dates below each of the "first" (red rows) in column 'C' should be based on the date in the cell above it.
6. The data in column 'D' should be pulled from columns D-F of each ID on the starting sheet in order of the columns. Basically what happens here it sees that the start date for the info on the originating sheet, populates that in the starting row of each ID, then populates the next month below it for as many months as there are on the originating sheet.
7. I would need this to continue to loop for as much data is on the originating sheet.

I hope I've explained this well. I cannot stress enough that the data will always come to me in that above table originating format and the columns and rows go on forever. So I'm dealing with massive amounts of data. I need this to be automated so as to minimize error and stop me from weeping softly in the corner whenver it's time to begin this task. Any help you can provide is appreciated. If you need more data or an attachment just let me know.

	A	B	C	D
1	ID	Group	Month	Hours
2	Number 1	A.02	Dec-13	46
3	Number 1	A.02	Jan-14	5
4	Number 1	A.02	Feb-14	12
5	Number 2	A.04	Jan-14	16
6	Number 2	A.04	Feb-14	25
7	Number 2	A.04	Mar-14	1
8	Number 3	A.01	Sep-13	3
9	Number 3	A.01	Oct-13	3
10	Number 3	A.01	Nov-13	6

<TBODY>
</TBODY>

 

[b.downey]

The attached code should fit your needs. It assumes the Source data is in Sheet 1 and the Destination data is posted to sheet 2

Option Explicit


Sub Process()
    Dim Ws As Worksheet
    Dim DstWs As Worksheet
    
    Dim SrcRowNo As Long
    Dim SrcColno As Long
    Dim DstRowNo As Long
    
    Set Ws = ThisWorkbook.Worksheets(1)
    Set DstWs = ThisWorkbook.Worksheets(2)
    
    DstRowNo = 2
    Application.ScreenUpdating = False
    
    For SrcRowNo = 2 To Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row
        Ws.Range(Ws.Cells(SrcRowNo, "A"), Ws.Cells(SrcRowNo, "C")).Copy
        For SrcColno = 4 To Ws.Cells(SrcRowNo, Ws.Columns.Count).End(xlToLeft).Column
            DstWs.Rows(DstRowNo).PasteSpecial
            DstWs.Cells(DstRowNo, "D") = Ws.Cells(SrcRowNo, SrcColno)
            DstRowNo = DstRowNo + 1
        Next SrcColno
        
        DoEvents
    Next SrcRowNo
    
    Application.ScreenUpdating = True
    
    MsgBox "Complete", vbInformation
End Sub

 

[Ebonii]

First and foremost, you're amazing. I was losing my mind trying to get to this. So thank you for the quick response.

The code is about 95% where I need it to be. For some reason on the destination sheet in the Month column (C), dates are duplicating as opposed to populating that first month for each starting row from the originating sheet, then filling in the next calendar months in order dependent on the number of columns.


Basically what I'm getting when I run it is:

	A	B	C	D
1	ID	Group	Month	Hours
2	Number 1	A.02	Dec-13	46
3	Number 1	A.02	Dec-13	5
4	Number 1	A.02	Dec-13	12
5	Number 2	A.04	Jan-13	16
6	Number 2	A.04	Jan-13	25
7	Number 2	A.04	Jan-13	1
8	Number 3	A.01	Sep-13	3
9	Number 3	A.01	Sep-13	3
10	Number 3	A.01	Sep-13	6

<TBODY>
</TBODY>

The only thing I need changed is column C. I need it to see that Start Date on the Destination sheet. Populate it in the first row of the unique ID (As your wonderful code currently does) but then in the following rows I need it to look at that start date and populate the next calendar month.

So referencing column C only below. In the destination sheet, column C should result in the month dates below. (The notes to the side are just indicators of what should be happening on that row in column 'C')

	C	Not part of needed code, just notes
1	Month
2	Dec-13	Start Date from Originating
3	Jan-14	need code to populate next month based on month above
4	Feb-14	need code to populate next month based on month above
5	Jan-13	Start Date from Originating
6	Feb-13	need code to populate next month based on month above
7	Mar-13	need code to populate next month based on month above
8	Sep-13	Start Date from Originating
9	Oct-13	need code to populate next month based on month above
10	Nov-13	need code to populate next month based on month above

<TBODY>
</TBODY>

Again, I cannot stress enough, that EVERYTHING else in your code does every miracle thing I was failing to do last night. So if you know how to tweak the code to address this date issue, I'd be so grateful. This code has been troubling me for a week now.

Thank you in advance for your help.

 

[b.downey]

No problem, He is the modification that increments the date to your specs.

Option Explicit


Sub Process()
    Dim Ws As Worksheet
    Dim DstWs As Worksheet
    
    Dim SrcRowNo As Long
    Dim SrcColno As Long
    Dim DstRowNo As Long
    
    Set Ws = ThisWorkbook.Worksheets(1)
    Set DstWs = ThisWorkbook.Worksheets(2)
    
    DstRowNo = 2
    Application.ScreenUpdating = False
    
    For SrcRowNo = 2 To Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row
        Ws.Range(Ws.Cells(SrcRowNo, "A"), Ws.Cells(SrcRowNo, "C")).Copy
        
        For SrcColno = 4 To Ws.Cells(SrcRowNo, Ws.Columns.Count).End(xlToLeft).Column
            DstWs.Rows(DstRowNo).PasteSpecial
            If IsDate(Ws.Cells(SrcRowNo, "c")) Then
                DstWs.Cells(DstRowNo, "c") = DateAdd("M", SrcColno - 4, Ws.Cells(SrcRowNo, "c"))
            Else
                DstWs.Cells(DstRowNo, "c") = ""
            End If
            DstWs.Cells(DstRowNo, "D") = Ws.Cells(SrcRowNo, SrcColno)
            DstRowNo = DstRowNo + 1
        Next SrcColno
        
        DoEvents
    Next SrcRowNo
    
    Application.ScreenUpdating = True
    
    MsgBox "Complete", vbInformation
End Sub

Let me know if it is not what is expected.

 

[Ebonii]

Yes! This is absolutely what I need! My apologies for the delay in responding, I've been traveling all day. You've also helped me see what I was doing wrong on my part. You are amazing thank you so much. Problem Solved!

 

[b.downey]

Excellent. Glad I could help