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

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.