Hi,

first post, hope I don't make too many gaffes

I found this macro that does what I want but I need to change it slightly.

It splits a big list onto different worksheets based on a category in column A.

I've tried but I can't work out how to make it look in a different column. Here's the code I have now, I already improved it to work with long category names with spaces in them.

Sub SplitIntoWorksheets() 
Dim rRange As Range, rCell As Range 
Dim wSheet As Worksheet 
Dim wSheetStart As Worksheet 
Dim strText As String 
Dim strTitle As String

* * Set  wSheetStart = ActiveSheet 
*  * wSheetStart.AutoFilterMode = False 
* * 'Set a range variable to the correct item  column 
* * Set rRange =  Range("A1", Range("A65536").End(xlUp)) 
* * 

* * * * 'Delete any sheet called  "UniqueList" 
* * *  * 'Turn off run time errors & delete alert 
* * * * On Error Resume Next  
* * * *  Application.DisplayAlerts = False 
* * * *  Worksheets("UniqueList").Delete 
* * * * 'Add a sheet called  "UniqueList" 

* * *  * Worksheets.Add().Name = "UniqueList" 
* * * * 
* * * * * *'Filter the Set range  so only a unique list is created 

* * * * * * With  Worksheets("UniqueList") 

*  * * * * * * * rRange.AdvancedFilter  xlFilterCopy, , Worksheets("UniqueList").Range("A1"), True  
* * * * * *  * * * 
* *  * * * * * * *'Set a range variable to the  unique list, less the heading. 

* * * * * * * *  *Set rRange = .Range("A2", .Range("A65536").End(xlUp))  

* * * * * *  End With 
* * *  * * * 

* *  * * * * On Error Resume Next 

* * * * * * With  wSheetStart 

* * *  * * * * * For Each rCell In rRange  

* * * * * *  * * * strText = rCell 
* * * * * * * * *  
* * * * *  * * * * strTitle = Replace(strText, " ", "_")
* * * * * * * * *  
* * * * *  * * * * strTitle = Left(strTitle, 31)

* * * * * *  * * *.Range("A1").AutoFilter 1, strText 

* * * * * * * *  * * Worksheets(strTitle).Delete

* * * * * *  * * * * 'Add a sheet named as content of rCell  

* * * * * *  * * * * Worksheets.Add().Name = strTitle

* * * *  * * * * * * 'Copy the visible filtered range  _ 

* * * *  * * * * * * '(default of Copy Method) and leave  hidden rows 

* * *  * * * * * * * .UsedRange.Copy  Destination:=ActiveSheet.Range("A1") 

* * * * * * * * *  * ActiveSheet.Cells.Columns.AutoFit 

* * * * * * * * Next  rCell 

* * * *  * * End With 
*  * * * * * 

* * * * With wSheetStart  

* * * * * *  .AutoFilterMode = False 

*  * * * * * .Activate 

* * * * End With 
 * * * 

* * * * On Error GoTo 0  

* * * *  Application.DisplayAlerts = True 

End Sub