Paste Data in excel from one column to another using breaks

Question

I have data in this format as show in the image

I want the data to be in the format as shown in the image below.

That means i want data from 1991 in image 1 to be pasted to 1991 from image 2, similarly, data from 1992 in image 1 to be pasted to 1992 from image 2. Instead of copying the data from 1991,1992,1993 manually from image 1 and pasting it in image 2, i want it to be done automatically using programming since I have large amount of data that needs to be managed. Can it be done by using VBA?

@Jeeped How would I unpivot a table which isn't a pivot table? — Variatus, Feb 18 '18 at 08:06
It is easy using Power Query, check the second answer in this post https://stackoverflow.com/questions/20541905/convert-matrix-to-3-column-table-reverse-pivot-unpivot-flatten-normal/20543651&ved=2ahUKEwjqnsOZx6_ZAhUBX60KHc7TAIcQjjgwAXoECA8QAQ&usg=AOvVaw09ZQka3sZI9shxmRhODU_- — virtualdvid, Feb 18 '18 at 13:23

score 0 · Answer 1 · answered Feb 18 '18 at 04:54

0

Yes, it could be done by VBA. What you need to do is put all your data in Image 1 into a dictionary. then for the image 2, you can just find the key in the dictionary and paste the result the cell.

PS: You can use Offset to access other cell

answered Feb 18 '18 at 04:54

Chongju Mai

127
1
8

score 0 · Accepted Answer · answered Feb 18 '18 at 08:46

Please try this code. Comments in the code will help you make the required adjustments, in particular the name of the worksheet which has your data and the first column to transpose.

Option Explicit

Sub Unpivot()
    ' 18 Feb 2018

    Const WsOutName As String = "Output"        ' name the result sheet
    Const CaptionRow As Long = 1                ' specifies the row with the captions
                                                ' the next row is presumed data

    Dim WsIn As Worksheet, WsOut As Worksheet
    Dim Rng As Range
    Dim Arr() As Variant
    Dim Cap As Variant
    Dim C As Long, Cl As Long                   ' column, Last column
    Dim R As Long, Rl As Long                   ' row, Last row

    Application.ScreenUpdating = False
    On Error Resume Next
    Set WsOut = Worksheets(WsOutName)
    If Err Then
        Set WsOut = Worksheets.Add(Before:=Worksheets(1))
        WsOut.Name = WsOutName
    Else
        WsOut.Cells.ClearContents               ' delete all existing content
    End If
    On Error GoTo 0

    Set WsIn = Worksheets("Unpivot")            ' change to match
    With WsIn
        Cl = .Cells(CaptionRow, .Columns.Count).End(xlToLeft).Column
        ' (2 = B) specifies first column to look at
        For C = 2 To Cl
            ' columns can be of different lengths
            Rl = .Cells(.Rows.Count, C).End(xlUp).Row
            If Rl > CaptionRow Then
                Cap = .Cells(CaptionRow, C).Value
                Set Rng = Range(.Cells(CaptionRow + 1, C), .Cells(Rl, C))
                Arr = Rng.Value
            End If
            With WsOut
                Rl = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                .Cells(Rl, 1).Resize(UBound(Arr), 1).Value = Cap
                .Cells(Rl, 2).Resize(UBound(Arr), 1).Value = Arr
            End With
        Next C
    End With
    Application.ScreenUpdating = True
End Sub

Paste Data in excel from one column to another using breaks

2 Answers2