VBA copy all values and truncate string

tybalt

New Member
Joined
May 19, 2011
Messages
17
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:
Code:
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
 

Some videos you may like

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

Watch MrExcel Video

Forum statistics

Threads
1,123,172
Messages
5,600,128
Members
414,365
Latest member
UUR

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top