VBA to name a new Worksheet based on a range of values in a column

Question

VBA to name a new worksheet based on a range of values in a column Hi, I am somewhat new to writing VBA. I spent all weekend working on several pieces and have gotten most of them working. I am stumped on this part and some other parts.

I am trying to create a new worksheet and name it based on the values in a column on a different worksheet.

For example, On Distribution (3) worksheet, in column B, I have 13 different values.

I want to name the newly created worksheet the text value in cell B2 on the Distribution (3) worksheet.

Then I want to create another worksheet and name it based on the value in B3 on the Distribution (3) worksheet.

OR add x number of worksheets and then name them.

I already figured out the VBA to create x number of worksheets but I have to put in the number of needed worksheets by hand (in the loop).

What could work is to get a count of the values in the B2:B14 range and then add that count of worksheets if I could figure out how to pass that value into existing code.

I have tried saving names to a variable. (Could be an array for all I know but do not know how to extract the value in each one). I only know how to print those values to an Immediate window. See #1 below.

1 I found this VBA on StackOverflow. Thank you.

    Sub RegionNames()
    Dim DatArr As Range
    Dim AuxDat As Range
    Dim CellCnt As Integer

    Set DatArr = _
    Application.InputBox( _
    "Select a contiguous range of cells.", _
    "SelectARAnge Demo", _
    Selection.Address, , , , , 8)

    CellCnt = DatArr.Count

    If DatArr.Columns(1).Column > 1 Then  '<<small error trap in case the user     selects column A
    Set AuxDat = DatArr.Offset.Offset(0, -1)
    End If

    Debug.Print AuxDat.Count
    Debug.Print AuxDat(1).Value
    Debug.Print DatArr(0) ' This is "Region"
    Debug.Print DatArr(1) ' This is "Atlanta"
    Debug.Print DatArr(2) ' ...
    Debug.Print DatArr(3)
    Debug.Print DatArr(4)
    Debug.Print DatArr(5)
    Debug.Print DatArr(6)
    Debug.Print DatArr(7)
    Debug.Print DatArr(8)
    Debug.Print DatArr(9)
    Debug.Print DatArr(10)
    Debug.Print DatArr(11)
    Debug.Print DatArr(12)
    Debug.Print DatArr(13)
    Debug.Print DatArr(14)

    End Sub

2

    Sub RegionList()
        Range("B2").Select
        Range(Selection, Selection.End(xlDown)).Select
    End Sub

3

    Sub MakeNewTab()
    Dim ws As Worksheet
    'ws.Name = "NewSheet"

    Set ws = Sheets.Add(After:=Sheets(Sheets.Count))

    Application.WindowState = xlNormal
    Sheets("Distribution (3)").Select
    Sheets("Distribution (3)").Name = "Distribution (3)"
    Range("B2:B14").Select
    Sheets("Sheet4").Select
    Sheets("Distribution (3)").Select
    End Sub

Answer 1

I actually just made an Excel that does this. I wrote the following:

    Dim c as Range
    Dim d as Range
    Dim PEndRange As Long
    Dim Pitem As String
    Dim PStartRange As Long
    Dim rng As Range
    Dim worksh As Long

    Set d = Nothing
    Set c = Nothing

'first I sort the table

    With Worksheets("Sheet1").Range("A1").EntireRow
    Set c = .Find("HEADER", LookIn:=xlValues)
    Set c = Worksheets("Sheet1").Cells(2, c.Column)
    Set d = .Find("VALUE", LookIn:=xlValues)
Pitem = c.Value
End With

'This grabs the Value of the cell in row 2 of whatever column contains the header you're searching through. You can do a loop and lookup instead using counta of cells(x,c.Column) for x = 2 to lastrow, then define the last row using 
ActiveWorkbook.Worksheets("Sheet1").Cells(ActiveWorkbook.Worksheets("Import").Rows.count, "A").End(xlUp).Row
, and then from there do a counta on Range(c.address).EntireColumn of that string, then set that value +1 as your range limit, then repeat after setting x as that value.


    If (c.EntireColumn.Find(what:=Pitem, lookat:=xlWhole, After:=Cells(2, c.Column)).Row)  0 Then
    PStartRange = c.EntireColumn.Find(what:=Pitem, After:=Cells(1, c.Column)).Row
    PEndRange = c.EntireColumn.Find(what:=Pitem, After:=Cells(1, c.Column), searchdirection:=xlPrevious).Row

    worksh = Application.Sheets.count
    worksheetexists = False
    For X = 1 To worksh
        If Worksheets(X).Name = left(Pitem, 29) Then 'trimmed in case string is longer than max allowed for sheet name
            worksheetexists = True
            GoTo NextStep:
            Exit For
        End If
    Next X

    Worksheets("Template").Copy After:=Sheets(Sheets.count) 'only if you have a template that already exists, otherwise you can just create a new sheet here
    Set newsheet = ActiveSheet
    newsheet.Name = left(Pitem, 29)

    NextStep:

    ActiveWorkbook.Worksheets(left(Pitem, 29)).Activate

End Sub

Answer 2

What you will need to do is just creat a loop to run through the range you need to create a name from, in your case through the Distribution (3) sheet and the Range("B2:B14"). ie the code would look something like this.

 Sub MakeNewTab()
    Dim ws As Worksheet

    For i = 2 To 14
       Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
       ws.Name = Sheets("Distribution (3)").Range("B" & i).Value
    Next i
End Sub

Then you would just call it how you want.