ffionnah

Board Regular
Joined
Jun 12, 2018
Messages
60
Good morning,
I have a macro that organizes data and then splits that data into different tabs based on a name in column AC. The issue I just ran into was when the name was too long for a tab (character limit I believe is 30).

Is there a way to update this macro to either read only to the 30th character and copy that name into the Tab Name or would it be easier to paste this name into a different column, with some sort of formula =Left(A2,30)?

Thank you in advance!

Code:
Sub Split_data_Name()
With ActiveSheet.Sort
       With .SortFields
            .Clear
            .Add Key:=Range("AC1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
           .Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
           .Add Key:=Range("D1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("H1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("F1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("O1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("I1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
       .Apply
    End With
    
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 29
Set ws = ActiveWorkbook.ActiveSheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:AO1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Contract Name"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub
 

Some videos you may like

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,058
Office Version
  1. 365
Platform
  1. Windows
Try
Code:
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = left(myarr(i),30)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,058
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,108,585
Messages
5,523,734
Members
409,533
Latest member
rinogjb

This Week's Hot Topics

Top