-1

I have an excel table with the following format:

titleA        titleB      titleC
  a            300          400
  b            300         
  c            50            20

I wish to merge columns titleB and titleC into a single column (titleB) so that the final table will be:

titleA        titleB
  a             300
  a             400
  b             300
  c              50
  c              20

Can you show me some VBA code that will allow me to do that? Thank you!!!

Community
  • 1
  • 1
  • 2
    yes you can do it with VBA, what have you tried so far ? edit your post with your code attmept – Shai Rado Aug 29 '16 at 18:01
  • 2
    What you want to do is called `unpivot`. Just search for it and you will find multiple answers: http://stackoverflow.com/search?q=unpivot+%5Bexcel-vba%5D Most answers will suggest a non-VBA solution. But if you want to accomplish this the VBA way then you can simply let the macro recorder record your actions. Here is one http://stackoverflow.com/questions/11568637/rearrange-certain-columns-and-rows and here another http://stackoverflow.com/questions/32115219/unpivot-an-excel-matrix-pivot-table or here http://stackoverflow.com/questions/33790370/efficiently-reformat-data-layout – Ralph Aug 29 '16 at 18:06
  • Possible duplicate of [Efficiently reformat data layout](http://stackoverflow.com/questions/33790370/efficiently-reformat-data-layout) – Ralph Aug 29 '16 at 18:07
  • Referred to actual column names and fixed grammar. – Andrew Cowenhoven Aug 31 '16 at 19:29

1 Answers1

0

assuming your data are in columns "A:C" and title are in row 1, you could try this code:

Sub main()
    With Worksheets("unpivot") '<--| change it to your actual worksheet name
        With .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
            .Offset(.Rows.Count).value = .value
            .Offset(.Rows.Count, 1).value = .Offset(, 2).value
            .Offset(-1, 2).Resize(.Rows.Count + 1).ClearContents
            With .Offset(, 1).Resize(2 * .Rows.Count)
                If WorksheetFunction.CountBlank(.Cells) > 0 Then .SpecialCells(XlCellType.xlCellTypeBlanks).EntireRow.Delete
            End With
            .Resize(2 * .Rows.Count, 2).Sort key1:=.Range("A1"), Order1:=xlAscending, Header:=xlNo
        End With
    End With
End Sub
user3598756
  • 28,893
  • 4
  • 18
  • 28