VBA To Display Data Horizontally

[contraububu]

Hi All! Can you help me with this excel function? I have a list of events that displayed vertically, and I would like to show the data horizontally one line for each person. Here is how the data looks now:

	A	B	C
1	Michael	09/15/2016	Egg
2	Michael	04/01/2016	Basket
3	Michael	09/08/2016	Fold
4	Frank	10/16/2015	Knife
5	Edmond	10/16/2015	Napkins
6	Lina	04/01/2016	Paper
7	Lina	09/01/2016	Fold
8	Laura	04/01/2016	Basket
9	Laura	07/23/2016	Tissues

<tbody>
</tbody>

And this is what I would like to show the data in this format (horizontally) on a separate sheet:

Michael	09/15/2016	Egg	04/01/2016	Basket	09/08/2016	Fold
Frank	10/16/2015	Knife
Edmond	10/16/2015	Napkins
Lina	04/01/2016	Paper	09/01/2016	Fold
Laura	04/01/2016	Basket	07/23/2016	Tissues

<tbody>
</tbody>

I'm not <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym> savvy honestly; however, let me know what information I need to replace/rename so that your VBA codes will work. Thanks so much!

 

[hiker95]

contraububu,

Here is a macro solution for you to consider, that is based on the structure of your displayed raw data worksheet, and, the resulting worksheet.

I assume that your raw data is in worksheet Sheet1.

And, the results will be written to a new worksheet Results.

Sample raw data:

Excel 2007
	A	B	C
1	Michael	09/15/2016	Egg
2	Michael	04/01/2016	Basket
3	Michael	09/08/2016	Fold
4	Frank	10/16/2015	Knife
5	Edmond	10/16/2015	Napkins
6	Lina	04/01/2016	Paper
7	Lina	09/01/2016	Fold
8	Laura	04/01/2016	Basket
9	Laura	07/23/2016	Tissues
10
11
Sheet1

And, after the macro in worksheet Results:

Excel 2007
	A	B	C	D	E	F	G	H
1
2	Michael	09/15/2016	Egg	04/01/2016	Basket	09/08/2016	Fold
3	Frank	10/16/2015	Knife
4	Edmond	10/16/2015	Napkins
5	Lina	04/01/2016	Paper	09/01/2016	Fold
6	Laura	04/01/2016	Basket	07/23/2016	Tissues
7
8
Results

If you were to add on the raw data worksheet, Sheet1, an additional row(s) of data like this:

Excel 2007
	A	B	C
1	Michael	09/15/2016	Egg
2	Michael	04/01/2016	Basket
3	Michael	09/08/2016	Fold
4	Frank	10/16/2015	Knife
5	Edmond	10/16/2015	Napkins
6	Lina	04/01/2016	Paper
7	Lina	09/01/2016	Fold
8	Laura	04/01/2016	Basket
9	Laura	07/23/2016	Tissues
10	hiker95	09/15/2016	Fold
11
Sheet1

And, run the macro again, you would get this:

Excel 2007
	A	B	C	D	E	F	G	H
1
2	Michael	09/15/2016	Egg	04/01/2016	Basket	09/08/2016	Fold
3	Frank	10/16/2015	Knife
4	Edmond	10/16/2015	Napkins
5	Lina	04/01/2016	Paper	09/01/2016	Fold
6	Laura	04/01/2016	Basket	07/23/2016	Tissues
7	hiker95	09/15/2016	Fold
8
Results

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub ReorgData()
' hiker95, 01/06/2017, ME984205
Dim w1 As Worksheet, wr As Worksheet
Dim a As Range, n As Range
Dim nr As Long, nc As Long, lc As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wr = Sheets("Results")
wr.UsedRange.Clear
nr = 1
With w1
  For Each a In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    Set n = wr.Columns(1).Find(a.Value, LookAt:=xlWhole)
    If n Is Nothing Then
      nr = nr + 1
      wr.Cells(nr, 1).Resize(, 3).Value = a.Resize(, 3).Value
      wr.Cells(nr, 2).NumberFormat = "mm/dd/yyyy"
    ElseIf Not n Is Nothing Then
      nc = wr.Cells(nr, .Columns.Count).End(xlToLeft).Column + 1
      wr.Cells(n.Row, nc).Resize(, 2).Value = a.Offset(, 1).Resize(, 2).Value
      wr.Cells(n.Row, nc).NumberFormat = "mm/dd/yyyy"
    End If
  Next a
End With
With wr
  lc = .Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
  .Columns(1).Resize(, lc).AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ReorgData macro.

 

[contraububu]

Thanks, hiker95!

What if I have multiple data on the right of the worksheet in column D, E, F, G, etc.? What should I change in the codes above to take more columns than just the first 3 columns?

 

[hiker95]

Thanks, hiker95!

contraububu,

Thanks for the feedback.

You are very welcome. Glad I could help.

What if I have multiple data on the right of the worksheet in column D, E, F, G, etc.? What should I change in the codes above to take more columns than just the first 3 columns?

I would have to see what the new raw data looks like, and, what the results should look like, per your reply #1.