VBA copy all values and truncate string

[tybalt]

Hi,

I have an awesome bit of VBA code that I adapted from Contextures (thank you!). I need to make a couple more adaptations and I can't quite figure them out.

The two adaptations I need to make are:

1) currently the coding aggregates all the same names in column A and copys them into the same sheet. for example if Michael Todd is in multiple rows in column A, they will all be together in one sheet 'Michael Todd' I'd like a new sheet for each line, thus creating 2 sheets titled Michael todd

2) Sometimes we have really long names. I'd like to use the Left function (or another if thereis a better alternative) to truncate the string to 31 characters.

Thanks in advance for any help!

the code I'm using is below:

Option Explicit
' Developed by Contextures Inc.
' [URL="http://www.contextures.com"]www.contextures.com[/URL]
Sub ExtractChampions()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("Sheet1")
Set rng = Range("Database")
'extract a list of Sales Reps
ws1.Columns("A:A").AdvancedFilter _
  Action:=xlFilterCopy, _
  CopyToRange:=Range("AJ1"), Unique:=True
r = Cells(Rows.Count, "AJ").End(xlUp).Row
'set up Criteria Area
Range("AL1").Value = Range("A1").Value
For Each c In Range("AJ2:AJ" & r)
  'add the rep name to the criteria area
   ws1.Range("AL2").Value = _
            "=""="" & " & Chr(34) & c.Value & Chr(34)
  'add new sheet and run advanced filter
  Set wsNew = Sheets.Add
  wsNew.Move After:=Worksheets(Worksheets.Count)
  wsNew.Name = c.Value
  rng.AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=Sheets("Sheet1").Range("AL1:AL2"), _
      CopyToRange:=wsNew.Range("A1"), _
      Unique:=False
Next
ws1.Select
ws1.Columns("AJ:AL").Delete
End Sub