Matching Multiple Header Row Cell Values - Copy the data below to next available row.

[B-radK]

Hi Team,

I have data in "Sheet1" which needs to be copied to "Sheet2".
In Row1 of Sheet1, starting from Column J, I have the days of the year (1/1/24 to 31/12/24) set out individually in each cell.
I have the days of the year, set out 5 times, one after the other. I.e., after 31/12/24, it starts again at 1/1/24. The total range is J1:BRS1, which totals 5 lots of days of the year (All for the year 2024).

Under each of these columns, I have 5 x of data for each day of the year.

I would like the code to:

1. Start at Column J (J1),
2. Check to see if there is data in the Cell below (J2),
3. If there is data in J2, scan through Row 1 to find the same dates in the other 4 x sets of dates, (In this example "01-Jan" appears in cells NL1, ABN1, APP1 and BDR1).
4. Then copy the date (01-Jan) from Cell J1, and also the data from the Cells below under the matching dates, (In this case, copy "01-Jan" (Cell J1) and the data in NL2, ABN2, APP2 and BDR1).
5. Then paste into Sheet2 in the first available row in Columns A, E, F, G and H, respectively. (NL2 to A, ABN2 to E, APP2 to G and BDR2 to H).
6. I also have Columns in Sheet1 (Columns A, B, and C), with data in them,
7. Which would also need to be copied along (with the data above) in the corresponding row (in this case the data in Row 2)
8. And pasted into Sheet2, in Columns B, C and D. (A to B, B to C and C to D).
9. The code would then have to go back to column J,
10. Then search for the next new cell with data in it. (in this case J3, because we already did J2 / Row 2).
11. And copy the data from Cell J3 (and also the date again from J1 (01-Jan) along with the other corresponding data in this row and the Columns mentioned above (in this case NL3, ABN3, APP3, BDR1, A, B and C).
12. And paste it into the next available row in Sheet2, to the same Columns mentioned above (A to H).
13. Then repeat until there is an empty cell in Column J,
14. In which case do not copy the empty cell,
15. Then move to the next Colum to the right (in this case Column K),
16. And repeat the process until the code finishes with the data in Column NK.

My coding is not the best and I also tried incorporating recording and searching through a few threads, but no real success.
The code below works (to a degree), but when I code "..... .Cells (i, j + 1473).Value" for example, because of the different number of days in the month, it captures the incorrect Column, therefore the incorrect data.

I hope I've clearly defined what I'm trying to achieve and any help would certainly be welcome.

Thanks,
Brad.

Sub CopyDataToSheet2()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim data As Variant
    Dim i As Long, j As Long
    Dim copyValue As String
    Dim copyFlag As Boolean
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    lastRow = ws1.Cells(ws1.Rows.Count, "J").End(xlUp).Row
    lastCol = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
    
    data = ws1.Range(ws1.Cells(1, 10), ws1.Cells(lastRow, lastCol)).Value
    
    For j = 1 To UBound(data, 2)
        copyFlag = False
        For i = 2 To UBound(data, 1)
            If Not IsEmpty(data(i, j)) Then
                If Not copyFlag Then
                    copyValue = data(1, j)
                    ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(UBound(data, 1) - 1, 1).Value = copyValue
                    copyFlag = True
                End If
                ws2.Cells(ws2.Rows.Count, "B").End(xlUp).Offset(1, 0).Value = ws1.Cells(i, 1).Value
                ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Offset(1, 0).Value = ws1.Cells(i, 2).Value
                ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Offset(1, 0).Value = ws1.Cells(i, 3).Value
                ws2.Cells(ws2.Rows.Count, "E").End(xlUp).Offset(1, 0).Value = ws1.Cells(i, j + 1473).Value
                ws2.Cells(ws2.Rows.Count, "F").End(xlUp).Offset(1, 0).Value = ws1.Cells(i, j + 1107).Value
                ws2.Cells(ws2.Rows.Count, "G").End(xlUp).Offset(1, 0).Value = ws1.Cells(i, j + 741).Value
                ws2.Cells(ws2.Rows.Count, "H").End(xlUp).Offset(1, 0).Value = ws1.Cells(i, j + 375).Value
                
            End If
        Next i
    Next j
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[bobaol]

hi, what about moving all you data to columns ABCDEFGHI first, regardless if it has data or not. that way, you're not worrying about if it has data, just move all the data. After it is all moved, then sort by column A, as A is where you're asking if there is data or not. or sort whatever columns you need to sort. your mapping was a bit confusing. A to B, B to C and C to D, NL2 to A, ABN2 to E, APP2 to G and BDR2 to H. What about is J1 and J2? is J2 to F, and J1 to i?

 

[B-radK]

Hello Babaol,

Thanks for your reply. I actually achieved what I needed using Power Query and unpivoting the columns to rows.

Thanks,
Brad.