Thread: Sorting "apples" and "bananas" from one list into two separate lists?

Hi,
I have a master list which contains only "apples" and "bananas" in a mixed order in the first column, and the associated data (e.g. kilograms) in the second column.
I would like to sort the data from this master list and make two separate lists, one with the "apples" data and one with the "bananas" data. I use Excel 2003. Any suggestions would be greatly appreciated.
Please see the attached sample file. Thanks.

lonely707,


Welcome to the Excel Forum.


Detach/open workbook DistributeGroups w1 AB - lonely707 - EF811505 - SDG10.xls and run the DistributeGroups 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, 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 DistributeGroups()
' stanleydgromjr, 01/26/2012
' http://www.excelforum.com/excel-general/811505-sorting-apples-and-bananas-from-one-list-into-two-separate-lists.html
Dim w1 As Worksheet, wC As Worksheet
Dim lr As Long, lrc As Long, r As Long, nc As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
w1.Rows(1).Insert
w1.Range("A1:B1") = [{"A","B"}]
lr = w1.Range("A" & Rows.Count).End(xlUp).Row
Set wC = Worksheets.Add
w1.Range("A1:A" & lr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wC.Range("A1"), Unique:=True
lrc = wC.Range("A" & Rows.Count).End(xlUp).Row
nc = 5
For r = 2 To lrc Step 1
  w1.Range("A1:B" & lr).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wC.Range("A1:A2"), CopyToRange:=w1.Cells(1, nc), Unique:=False
  wC.Rows(2).Delete
  nc = w1.Cells(1, Columns.Count).End(xlToLeft).Column + 2
Next r
Application.DisplayAlerts = False
wC.Delete
Application.DisplayAlerts = True
w1.Rows(1).Delete
Application.ScreenUpdating = True
End Sub

Then run the DistributeGroups macro.

This little macro will split your two column data set into as many columns as you have unique values, not just two.

Option Explicit

Sub SplitLists()
Dim vFIND As Range, vRNG As Range, v As Range

Set vRNG = Range("A:A").SpecialCells(xlConstants)
On Error Resume Next

For Each v In vRNG
    Set vFIND = Range("D1:IV1").Find(v, LookIn:=xlValues, LookAt:=xlWhole)
    If vFIND Is Nothing Then
        Set vFIND = Cells(1, Columns.Count).End(xlToLeft).Offset(, 2)
        vFIND.Resize(, 2).Value = v.Resize(, 2).Value
    Else
        Cells(Rows.Count, vFIND.Column).End(xlUp).Offset(1).Resize(, 2) = v.Resize(, 2).Value
        Set vFIND = Nothing
    End If
Next v

End Sub

I've added it to your sample workbook with a button. Just clear the sheet and drop in your real data, then run the macro.

Jerry,

Nice. One for my archives.

Thanks.

If that takes care of your need, please click EDIT in your original post, click GO ADVANCED and set the PREFIX box to SOLVED.

Take a look at this approach as well and let us know if this could work for you.