Moving vertical entries to a horizontal entries and eliminate the extra space

RpTheHotrod

New Member
Joined
Sep 12, 2008
Messages
14
First, thanks for continuing to be an awesome community!

Second, I'm trying to accomplish something by forumla. I'm not familiar with VBA in excel, but if I need to do that, then I'm willing to work my way through it.

Here's an image of my current challenge:

https://i.imgur.com/MNyjiwb.png

Essentially, the top part of the image is what I have currently (Originally I only had ABC, but I needed to make the dates a header, and I could then populate the NUMBER accordingly). However, I need to now "save" space by collapsing an ID to only one row. The results of this would be the AFTER part at the bottom of the image.

I thought about using VLOOKUP, but VLOOKUP would end up searching for data outside of each ID section. For example, if I did a VLOOKUP in column DATE, I'd be searching for dates in both NAME(ID) and NAME 2(ID). The dates are not always the same for every ID.

Any ideas?
 

Some videos you may like

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,686
Office Version
  1. 2010
Platform
  1. Windows
Give this macro a try (it places its output at the bottom of your data after the last name's data group)...
Code:
[table="width: 500"]
[tr]
	[td]Sub RearrangeAndCollapse()
  Dim LastRow As Long, LastCol As Long, NameBlocks As Range, Ar As Range
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
  Set NameBlocks = Range("B2", Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlConstants)
  Application.ScreenUpdating = False
  Cells(LastRow + 2, "A").Resize(, LastCol - 2) = Split("Name," & Join(Application.Index(Range("D1", Cells(1, LastCol)).Value, 1, 0), ","), ",")
  On Error Resume Next
  For Each Ar In NameBlocks.Areas
    With Cells(Rows.Count, "A").End(xlUp)
      Ar(1).Offset(, -1).Copy .Offset(1)
      Intersect(Ar.EntireRow, Columns("D").Resize(, LastCol)).Copy .Offset(1, 1)
      .Offset(1, 1).Resize(Ar.Rows.Count, LastCol - 2).SpecialCells(xlBlanks).Delete xlShiftUp
    End With
  Next
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

HOW TO INSTALL MACROs
------------------------------------
If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (RearrangeAndCollapse) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.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.
 
Last edited:

RpTheHotrod

New Member
Joined
Sep 12, 2008
Messages
14
Give this macro a try (it places its output at the bottom of your data after the last name's data group)...
Code:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub RearrangeAndCollapse()
  Dim LastRow As Long, LastCol As Long, NameBlocks As Range, Ar As Range
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
  Set NameBlocks = Range("B2", Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlConstants)
  Application.ScreenUpdating = False
  Cells(LastRow + 2, "A").Resize(, LastCol - 2) = Split("Name," & Join(Application.Index(Range("D1", Cells(1, LastCol)).Value, 1, 0), ","), ",")
  On Error Resume Next
  For Each Ar In NameBlocks.Areas
    With Cells(Rows.Count, "A").End(xlUp)
      Ar(1).Offset(, -1).Copy .Offset(1)
      Intersect(Ar.EntireRow, Columns("D").Resize(, LastCol)).Copy .Offset(1, 1)
      .Offset(1, 1).Resize(Ar.Rows.Count, LastCol - 2).SpecialCells(xlBlanks).Delete xlShiftUp
    End With
  Next
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

HOW TO INSTALL MACROs
------------------------------------
If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (RearrangeAndCollapse) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.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.

This worked perfectly. Thank you! Now I get to dissect and figure out how it works :x
 

Watch MrExcel Video

Forum statistics

Threads
1,122,646
Messages
5,597,356
Members
414,138
Latest member
Ankitjainkaka

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top