VBA: Create new sheet name based on unique names in column K

sachavez

Active Member
Joined
May 22, 2009
Messages
446
Hello,

Looking for a VBA solution that will look for unique names in column K and then create a new sheet for each name. My data set varies each week, and I am using UR = Activesheet.Usedrange.Rows.Count to determine the number of rows in the data set. I have a header row, which does not need a new tab name.

Thanks in advance.

Steve
 

Some videos you may like

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

Repush

Board Regular
Joined
Sep 21, 2015
Messages
133
Office Version
  1. 2013
Platform
  1. Windows
part one:
Code:
Sub SheetsFromRange()
    Dim Start As Range, c As Range
    Set Start = ActiveSheet.Range("A1").CurrentRegion
    For Each c In Start
        ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Name = c.Value
    Next c
End Sub
part two:
Code:
Sub UniqueSort()
    Dim UList, i As Long
    UList = ActiveCell.CurrentRegion.Columns(1)
    With CreateObject("System.Collections.ArrayList")
        For i = 1 To UBound(UList)
            If UList(i, 1) <> "" And Not .contains(UList(i, 1)) Then .Add UList(i, 1)
        Next i
        .Sort
        ActiveCell.Offset(, 3).Resize(.Count) = Application.Transpose(.toarray)
    End With
End Sub
It's up to you to combine and tweak
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,575
Office Version
  1. 365
Platform
  1. Windows
Try this:

Code:
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1090800b()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1090800-vba-create-new-sheet-name-based-unique-names-column-k.html[/COLOR][/I]

[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va
[COLOR=Royalblue]Dim[/COLOR] d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] ws [COLOR=Royalblue]As[/COLOR] Worksheet

Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
[COLOR=Royalblue]Set[/COLOR] d = CreateObject([COLOR=brown]"scripting.dictionary"[/COLOR])
d.CompareMode = vbTextCompare
    [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] ws [COLOR=Royalblue]In[/COLOR] ActiveWorkbook.Worksheets
    d(ws.Name) = [COLOR=brown]""[/COLOR]
    [COLOR=Royalblue]Next[/COLOR]

va = Range([COLOR=brown]"K2"[/COLOR], Cells(Rows.count, [COLOR=brown]"K"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))
    [COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
        [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] d.Exists(va(i, [COLOR=crimson]1[/COLOR])) [COLOR=Royalblue]Then[/COLOR]
        Sheets.Add(After:=Worksheets(Worksheets.count)).Name = va(i, [COLOR=crimson]1[/COLOR])
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    [COLOR=Royalblue]Next[/COLOR]
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
 

sachavez

Active Member
Joined
May 22, 2009
Messages
446
Thank you, Akuini. This generated 824 tabs, which is the number of rows in my data set. In the data set, I should only have 6 unique names.

Steve
 

sachavez

Active Member
Joined
May 22, 2009
Messages
446

ADVERTISEMENT

Thanks. Trying to make these work.

Steve
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,346
Office Version
  1. 365
Platform
  1. Windows
Another option
Code:
Sub sachavez()
   Dim Cl As Range
   
   For Each Cl In Range("K2", Range("K" & Rows.Count).End(xlUp))
      If Not Evaluate("isref('" & Cl.Value & "'!A1)") Then
         Sheets.Add(, Sheets(Sheets.Count)).Name = Cl.Value
      End If
   Next Cl
End Sub
 

sachavez

Active Member
Joined
May 22, 2009
Messages
446

ADVERTISEMENT

Fluff. BINGO. Thank you so much! Problem solved!!!

Another option
Code:
Sub sachavez()
   Dim Cl As Range
   
   For Each Cl In Range("K2", Range("K" & Rows.Count).End(xlUp))
      If Not Evaluate("isref('" & Cl.Value & "'!A1)") Then
         Sheets.Add(, Sheets(Sheets.Count)).Name = Cl.Value
      End If
   Next Cl
End Sub
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,575
Office Version
  1. 365
Platform
  1. Windows
Thank you, Akuini. This generated 824 tabs, which is the number of rows in my data set. In the data set, I should only have 6 unique names.

Steve

Hm, I don't understand, it worked for me. The list is in col K, isn't it?

Edit: Ah, you're right I forget to add the new value to the dictionary.
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,109,045
Messages
5,526,447
Members
409,701
Latest member
nitmani

This Week's Hot Topics

Top