The user needs to consolidate a large spreadsheet ID#s (column A) can be repeated any number of times but each time they are repeated, there is a separate set of columns. The user needs each ID# to have its own row and need the columns to remain but need the values to be in the appropriate row.
If you want to use the macro on another workbook, with your raw data in Sheet1:
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, by highlighting the code and pressing the keys CTRL + C
2. Open your 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 by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.
Option Explicit Sub ReorgData() ' Stanley D. Grom, 06/14/2011 ' http://www.ozgrid.com/forum/showthread.php?t=155071 Dim w1 As Worksheet, wR As Worksheet Dim LC As Long, LR As Long, a As Long, aa As Long Dim c As Range, firstaddress As String Application.ScreenUpdating = False Set w1 = Worksheets("Sheet1") If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results" Set wR = Worksheets("Results") wR.UsedRange.Clear w1.Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wR.Columns(1), Unique:=True LC = w1.Cells(1, Columns.Count).End(xlToLeft).Column w1.Range(w1.Cells(1, 2), w1.Cells(1, LC)).Copy wR.Range("B1") LR = wR.Cells(Rows.Count, 1).End(xlUp).Row wR.Range("A2:A" & LR).Sort Key1:=wR.Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal For a = 2 To LR Step 1 firstaddress = "" With w1.Columns(1) Set c = .Find(wR.Cells(a, 1), LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then firstaddress = c.Address Do For aa = 2 To LC Step 1 If w1.Cells(c.Row, aa) <> "" Then wR.Cells(a, aa).Value = w1.Cells(c.Row, aa).Value End If Next aa Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstaddress End If End With Next a wR.Range(wR.Cells(2, 2), wR.Cells(LR, LC)).HorizontalAlignment = xlCenter wR.Activate Application.ScreenUpdating = True End Sub
Then run the ReorgDate macro.
See file using the following link: 98209-combine-rows-with-the-same-id-but-different-columns
Obtained from the OzGrid Help Forum.
Solution provided by Stanley D Grom.
|How to use Excel VBA macro to convert multiple columns to multiple rows|
|How to sum up columns in each row and highlight until that value|
|How to create vertical page breaks every X column|
|How to transpose single column into multiple columns and rows|
|How to create VBA to copy specific column from one sheet to another|
|How to use a macro or formula to copy data from cell to all cells in that group in adjacent column|