1

Source The source picture has names in the 1st column and the 1st row has dated. There are values for each date column. Need to get Dates and their values for each name if there is a value for a particular date.

Output

1 Answers1

1

A Simple Unpivot

enter image description here

Sub UnpivotRCV()
  
    ' Define constants.
    Const SRC_NAME As String = "Sheet1"
    Const DST_NAME As String = "Sheet2"
    Const DST_FIRST_CELL As String = "A2"
    Const DST_COLUMNS_COUNT As Long = 3 ' fixed
    
    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the source range.
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_NAME)
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion
    Dim srCount As Long: srCount = srg.Rows.Count
    Dim scCount As Long: scCount = srg.Columns.Count
    
    ' Write the values from the source range to the source array.
    Dim sData: sData = srg.Value
    
    ' Define the destination array.
    Dim drCount As Long: drCount = (srCount - 1) * (scCount - 1)
    Dim dData(): ReDim dData(1 To drCount, 1 To DST_COLUMNS_COUNT)
    
    Dim sr As Long, sc As Long, dr As Long
    
    ' Return the unpivoted values from the source array
    ' in the destination array.
    For sr = 2 To srCount
        For sc = 2 To scCount
            If Len(CStr(sData(sr, sc))) > 0 Then
                dr = dr + 1
                dData(dr, 1) = sData(sr, 1) ' row label
                dData(dr, 2) = sData(1, sc) ' column label
                dData(dr, 3) = sData(sr, sc) ' value
            End If
        Next sc
    Next sr
    
    ' Reference the destination range.
    Dim dws As Worksheet: Set dws = wb.Sheets(DST_NAME)
    Dim dfCell As Range: Set dfCell = dws.Range(DST_FIRST_CELL)
    Dim drg As Range: Set drg = dfCell.Resize(dr, DST_COLUMNS_COUNT)
    
    ' Write, clear and autfit.
    drg.Value = dData
    drg.Resize(dws.Rows.Count - drg.Row - dr + 1).Offset(dr).ClearContents
    drg.EntireColumn.AutoFit
    
    MsgBox "Data unpivoted.", vbInformation
    
End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
  • Thank you so much for the quick solution. Can we pick only first 12 values? – Sunny Jayadev Feb 16 '23 at 15:03
  • Use `Set srg = sws.Range("A1").CurrentRegion.Resize(, 13)` i.e. `12 + 1` for the row labels in column `A`. – VBasic2008 Feb 16 '23 at 15:22
  • After making this change, it is picking only values till 12th month. For example, if a row has value from 5th month of 2022 till 8th month of 2023, this change is picking values from 5th to 12th month of 2022 only – Sunny Jayadev Feb 16 '23 at 16:05
  • Implement another counter e.g. `Dim n As Long`, Right below `For sr...` use `n = 0`. In the `If` clause use `n = n + 1` and right below `End If` use `If n = 12 Then Exit For`. – VBasic2008 Feb 16 '23 at 23:40