How to convert year based multi line data in single line for each customer?

[vletm]

Chirag R Raval
#24 Reply has four steps ... follow those steps.

That Your other case ...
https://chandoo.org/forum/threads/can-not-hide-delete-sheet-or-workbook-from-personnel-xlsb.38606/

 

[Chirag R Raval]

Dear Sir @vletm,

Thank you very much ...I forgot that ..I need to re-install office-2016-64 bit.
for out come from lost hierarchy in VBA .


yes I can now see that code ...as per your post no 24.

here it is

Private Sub ConvMultiLineToSingleLine2ok()
Dim o_tab As String
Dim r_tab As String
Dim r As Long
Dim ymin As Long
Dim yr_min As Long
Dim yr_max As Long
Dim x As Long
Dim aa As Long
Dim yr As Long
Dim h As Long
Dim msg As String
Dim rmsg As Long
Dim ay As Long
Dim chk_d As Range

    On Error Resume Next
    Application.ScreenUpdating = False
  
    o_tab = "ORIGINAL"
    r_tab = "REQUIREMENT"
    r = 2
  
    Sheets(r_tab).UsedRange.ClearContents
      
    With Sheets(o_tab)
        yr_min = WorksheetFunction.Min(.Range("K:K"))
        yr_max = WorksheetFunction.Max(.Range("K:K"))
        x = 11
        aa = 2
        For yr = yr_min To yr_max
            For h = 0 To 5
                msg = .Cells(1, 12 + h)
                If h < 4 Then
                    rmsg = yr & "-" & msg
                    If h < 2 Then rmsg = Left(rmsg, 6)
                Else
                    rmsg = msg & "-" & yr
                End If
                Sheets(r_tab).Cells(1, x + h) = rmsg
            Next h
            aa = aa + 1
            x = x + 6
        Next yr
        For x = 1 To 10
            Sheets(r_tab).Cells(1, x) = .Cells(1, x)
        Next x
      
        ay = 2
        Do
            chk_d = .Cells(ay, 4)
            .Range("A" & ay & ":J" & ay).Copy Destination:=Sheets(r_tab).Cells(r, 1)
            Do
                x = 11 + (.Cells(ay, 11) - yr_min) * 6
                .Range("L" & ay & ":Q" & ay).Copy Destination:=Sheets(r_tab).Cells(r, x)
                ay = ay + 1
            Loop Until .Cells(ay, 4) <> chk_d
            r = r + 1
        Loop Until .Cells(ay + 1, 4) = Empty
    End With
    Sheets(r_tab).Select

    MsgBox "Done"
End Sub

yes I realise that whole database's start year & end year can be got through

yr_min = WorksheetFunction.Min(.Range("K:K"))

yr_max = WorksheetFunction.Max(.Range("K:K"))

I also realised that there are no need to headers prefilled on destination sheet
if data structure is fixed.

I already in further study your valuable code ...by press "F8" -step by step run code & try to understand steps taken by loop & conditions.

I will revert soon.

Thanks again.

Regards,

Chirag Raval

 

[Marc L]

New demo working with columns names and
creating destination worksheet headers :
• all columns before YEAR column are the headers fixed part
• all columns after YEAR column are the headers variable part
according to the unique years
• unique years are picked up with an advanced filter & a sort
• FIN_BUY_FOR_NAME column is used to identify records
• the logic to copy data is the same as previous demo …

Paste next code to REQUIREMENT worksheet module :​

Sub Demo2()
    Dim L&, C, Y, H, A%, F%, N%, S$, R&
    Me.UsedRange.Clear
    Application.ScreenUpdating = False
        L = 1
With Worksheets("ORIGINAL").[A1].CurrentRegion
        C = Application.Match("FIN_BUY_FOR_NAME", .Rows(1), 0)
        Y = Application.Match("YEAR", .Rows(1), 0)
        If IsError(C) Or IsError(Y) Then Beep: Exit Sub
       .Columns(Y).AdvancedFilter xlFilterCopy, , [B1], True
    With Range("B2", [B1].End(xlDown))
       .Sort .Cells(1), xlAscending, Header:=xlNo
        H = Application.Transpose(.Value)
    End With
        A = Y + 1
        F = Y - 1
        N = .Columns.Count - Y
        S = Cells(A).Resize(, N).Address
       .Cells(1).Resize(, F).Copy [A1]
    For R = 1 To UBound(H)
        Cells(Y - N + R * N).Resize(, N).Value = .Parent.Evaluate(H(R) & "&"" ""&" & S)
    Next
    For R = 2 To .Rows.Count
        If .Cells(R, C).Value <> .Cells(R - 1, C).Value Then
            L = L + 1
            Cells(L, 1).Resize(, F).Value = .Cells(R, 1).Resize(, F).Value
        End If
            Cells(L, Y + (.Cells(R, Y).Value - H(1)) * N).Resize(, N).Value = .Cells(R, A).Resize(, N).Value
    Next
End With
    Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Chirag R Raval]

Dear Sir @Marc L,

Thank you very much for explore the concept about How to convert,
Multi line data for 1 core factor or element in single line,
As you can usethat single record & can control every it's part & can use that parts
as many ways in Excel & other database
applications like Access or other.


I will check & study your valuable effort & revert soon .

Regards,

Chicago Raval

 

[Marc L]

(2) Sheet Name may be differ (I want to use next sheet of data-any
name it have) so at the last of sheets count..

Unclear … As two sheets are concerned, which one may change ?

If it's the result worksheet, as at this time the code must be pasted to
the result worksheet, so its name does not matter …

If it's the source data worksheets, it depends where it stands in the workbook
as for example always the fisrt sheet or the one just before the result sheet.
But without any way / logic to pointed out this sheet,
you'll have to mod the code or the sheet name each time …
​

 

[Chirag R Raval]

Dear Sir @Marc L ,

Just Amazing , , Thanks for make it flexible for possible future modification.

I try to understand your logic in this code through "F8" in VBA.

My database is always in sheet1.
we can fall result at the end of sheets count as added new worksheet
.

I will revert soon sir, Thank you very much.

Regards,

Chirag Raval

 

[Marc L]

My database is always in sheet1.

So you can easily mod the procedure accordingly …
​