Excel re-formatting data

I need to change the view of data in my spreadsheet, but can't figure a solution of how to get from point a to b.

You will see in attached point A how the data is currently.  Column A has one row for each record giving the member ID.  Instead of several rows per member ID with the member ID duplicated on each row.  I need one row per member ID as in attached Point B.  You can see that the one row per member ID has the data regrouped horizontally with 3 columns per record etc.  How can I make this transition?
a.jpg
b.jpg
LVL 1
Shaye LarsenAsked:
Who is Participating?
 
byundtConnect With a Mentor Commented:
To install a macro:
1.  ALT + F11 to open the VBA Editor
2.  Insert...Module to create a new module sheet
3.  Paste the code there
4.  ALT + F11 to return to the worksheet user interface

To run a macro:
1.  ALT + F8 to open the macro selector
2.  Choose the macro, then click Run

To change macro security so you can run macros:
1.  In Office 2007, click the Office icon at top left of ribbon, then click the Options button at the bottom of resulting dialog. In Office 2010 and later, open the File...Options menu item
2.  Go to the Trust Center tab, then click the Trust Center Settings button
3.  Go to the Macro Settings tab
4.  Choose the option to "Disable macros with notification"
5.  Click OK twice

If Saqib's macro isn't working for you, here is another that you might try:
Sub Denormalizer()
Dim rg As Range, rgData As Range, rgTable As Range, rgUniques As Range, rw As Range
Dim wsResults As Worksheet
Dim v As Variant, vUniques As Variant
Dim i As Long, j As Long, k As Long, nCols As Long
Application.ScreenUpdating = False
With ActiveSheet
    Set rgTable = .Range("A1").CurrentRegion
    nCols = rgTable.Columns.Count
    Set rgData = rgTable.Offset(1, 0).Resize(rgTable.Rows.Count - 1)
    Set rgUniques = .UsedRange.Cells(1, .UsedRange.Columns.Count + 2)
    With .Sort
        .SortFields.Clear
        .SortFields.Add Key:=rgData.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=rgData.Columns(4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange rgTable
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    rgTable.Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rgUniques, Unique:=True
    Set rgUniques = Range(rgUniques, .Cells(.Rows.Count, rgUniques.Column).End(xlUp))
    vUniques = rgUniques.Offset(1, 0).Resize(rgUniques.Rows.Count - 1).Value
    rgUniques.EntireColumn.Delete
    rgTable.Cells(1, 1).AutoFilter
End With

On Error Resume Next
Set wsResults = Worksheets("Results")
If wsResults Is Nothing Then
    Set wsResults = Worksheets.Add(after:=ActiveSheet)
    wsResults.Name = "Results"
End If
wsResults.UsedRange.ClearContents
wsResults.Cells(1, 1).Resize(1, rgTable.Columns.Count).Value = rgTable.Rows(1).Value

i = 1
For Each v In vUniques
    i = i + 1
    j = 3 - nCols
    rgTable.AutoFilter Field:=1, Criteria1:=v
    wsResults.Cells(i, 1) = v
    For Each rw In rgData.SpecialCells(xlCellTypeVisible).Rows
        j = j + nCols - 1
        For k = 2 To nCols
            wsResults.Cells(i, j + k - 2).Value = rw.Cells(1, k).Value
        Next
    Next
Next
Set rg = wsResults.UsedRange
If rg.Columns.Count > nCols Then
    For k = nCols + 1 To rg.Columns.Count Step (nCols - 1)
        rg.Cells(1, k).Resize(1, nCols - 1).Value = rgTable.Cells(1, 2).Resize(1, nCols - 1).Value
    Next
End If
rg.EntireColumn.AutoFit
rgTable.Cells(1, 1).AutoFilter
End Sub

Open in new window


Sample workbook with macro installed and ready to run
aQ28415682.xlsm
0
 
Saqib Husain, SyedEngineerCommented:
Can you upload a sample for testing?
0
 
Shaye LarsenAuthor Commented:
SUre, here you go.
a.xlsx
0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Saqib Husain, SyedConnect With a Mentor EngineerCommented:
Sub a()
    Dim cel As Range
    Range("A2").EntireRow.Insert
    For Each cel In Range(Range("A3"), Range("A3").End(xlDown))
        If cel.Value = cel.End(xlUp) Then
            cel.ClearContents
            cel.Offset(, 1).Resize(, 3).Cut cel.End(xlUp).End(xlToRight).Offset(, 1)
        Else
            cel.Resize(, 4).Copy cel.End(xlUp).Offset(1)
            cel.Resize(, 4).ClearContents
        End If
    Next cel
    'Cells.EntireColumn.AutoFit
End Sub
0
 
Shaye LarsenAuthor Commented:
Sorry for my ignorance.  I assume this is a visual basic script I have to run.  Never done that.  Can you give me a quick instruction how to run that or point me to a source on how to?
0
 
byundtCommented:
My admittedly longer macro sorts the data by Member and then by date. It then uses Advanced Filter to get a list of Members, and performs successive AutoFilter operations to get the data for each Member. The report is written to worksheet Results, which will be added if necessary.

When the report is complete, the column width is autofitted and the header labels extended as required.

The macro should run in the blink of an eye.


Because your original data wasn't sorted, Saqib's macro will generate two rows of results for Members 5150 & 5152.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.