Excel Sort Grouping

mokk083,

Welcome to the Excel Forum.


Detach/open workbook ReorgData rngobject 2ndtitlerowsColumnSwitched - mokk083 - EF983186 - SDG15.xlsm and run the ReorgData macro.


If you want to use the macro on another workbook:


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.

Option Explicit
Sub ReorgData()
' stanleydgromjr, 01/21/2014, EF983186
Dim lr As Long, sr As Long, rng As Range
Dim prng As Range, nrng As Range, grng As Range, irng As Range
Dim p As Variant, n As Variant, g As Variant, i As Variant
Application.ScreenUpdating = True
lr = Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
Set rng = Range("A2:D" & lr)
Set prng = rng.Find("Player", LookAt:=xlWhole)
Set nrng = rng.Find("Number", LookAt:=xlWhole)
Set grng = rng.Find("GPA", LookAt:=xlWhole)
Set irng = rng.Find("IQ Score", LookAt:=xlWhole)
If (Not prng Is Nothing) * (Not nrng Is Nothing) * (Not grng Is Nothing) * (Not irng Is Nothing) Then
  sr = prng.Row
  p = Range(Cells(sr, prng.Column), Cells(lr, prng.Column))
  n = Range(Cells(sr, nrng.Column), Cells(lr, nrng.Column))
  g = Range(Cells(sr, grng.Column), Cells(lr, grng.Column))
  i = Range(Cells(sr, irng.Column), Cells(lr, irng.Column))
  Range("A" & sr & ":D" & lr).ClearContents
  Range("A" & sr & ":A" & lr) = p
  Range("B" & sr & ":B" & lr) = n
  Range("C" & sr & ":C" & lr) = g
  Range("D" & sr & ":D" & lr) = i
ElseIf (prng Is Nothing) * (nrng Is Nothing) * (grng Is Nothing) * (irng Is Nothing) Then
  Application.ScreenUpdating = True
  MsgBox "One or more of the titles 'Player' 'Number' 'GPA' 'IQ Score' were NOT found after row 1 - macro terminated!"
  Exit Sub
End If
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

Then run the ReorgData macro.

mokk083,

So basically, is there a way to sort them all to look like this???

Player | Number | GPA | IQ Score
Raul |17 |4.0 |190
Deigo |69 |1.0 | 60
Abe |16 |1.3 | 165
John |89 | 2.3 |169

Sorry, I missed this part - be back later with an updated macro.

mokk083,

Detach/open workbook ReorgDataV2 rngobject 2ndtitlerowsColumnSwitched - mokk083 - EF983186 - SDG15.xlsm and run the ReorgDataV2 macro.


If you want to use the macro on another workbook:


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).

Option Explicit
Sub ReorgDataV2()
' stanleydgromjr, 01/21/2014, EF983186
Dim lr As Long, sr As Long, rng As Range
Dim prng As Range, nrng As Range, grng As Range, irng As Range
Dim p As Variant, n As Variant, g As Variant, i As Variant
Application.ScreenUpdating = True
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("A2:D" & lr)
Set prng = rng.Find("Player", LookAt:=xlWhole)
Set nrng = rng.Find("Number", LookAt:=xlWhole)
Set grng = rng.Find("GPA", LookAt:=xlWhole)
Set irng = rng.Find("IQ Score", LookAt:=xlWhole)
If (Not prng Is Nothing) * (Not nrng Is Nothing) * (Not grng Is Nothing) * (Not irng Is Nothing) Then
  sr = prng.Row + 1
  p = Range(Cells(sr, prng.Column), Cells(lr, prng.Column))
  n = Range(Cells(sr, nrng.Column), Cells(lr, nrng.Column))
  g = Range(Cells(sr, grng.Column), Cells(lr, grng.Column))
  i = Range(Cells(sr, irng.Column), Cells(lr, irng.Column))
  Range("A" & sr - 1 & ":D" & lr).ClearContents
  Range("A" & sr).Resize(UBound(p, 1), UBound(p, 2)) = p
  Range("B" & sr).Resize(UBound(n, 1), UBound(n, 2)) = n
  Range("C" & sr).Resize(UBound(g, 1), UBound(g, 2)) = g
  Range("D" & sr).Resize(UBound(i, 1), UBound(i, 2)) = i
  lr = Cells(Rows.Count, 1).End(xlUp).Row
  Range("A2:D" & lr).Sort key1:=Range("A2"), order1:=1
ElseIf (prng Is Nothing) * (nrng Is Nothing) * (grng Is Nothing) * (irng Is Nothing) Then
  Application.ScreenUpdating = True
  MsgBox "One or more of the titles 'Player' 'Number' 'GPA' 'IQ Score' were NOT found after row 1 - macro terminated!"
  Exit Sub
End If
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

Then run the ReorgDataV2 macro.

mokk083,

It is always best to display your actual raw data, and, what the results should look like. This way a solution can usually be found on the first go.

I didn't think it would be a VBA solution.

You did not specify in your original thread that you wanted a formula solution.

In the Quick Reply box, just put the word BUMP. Then, click on the Post Quick Reply button, and someone else will assist you.



If you want me to continue with a macro solution for your new dataset, then I will have to see your actual raw data workbook.

To get the most precise answer, it is best to upload/attach a sample workbook (sensitive data scrubbed/removed/changed) that contains an example of your raw data on one worksheet, and on another worksheet your desired results.

The structure and data types of the sample workbook must exactly duplicate the real workbook. Include a clear and explicit explanation of your requirements.

To attach your workbook, scroll down and click on the Go Advanced button, then scroll down and click on the Manage Attachments button.