How to Combine rows with the same ID# but different columns

How to combine rows with the same ID# but different columns

Requirement:

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.

Solution:

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.

Code:

 
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.