Add named worksheets using For Loop

Question

I am trying to write a code that will take a list of titles/names, and create a tab for each one of them, with each worksheet having a name from the list. For example, given a table on the ActiveSheet (might not necessarily be sheet1)

Metric | Comments | Title
   1   | testing1 | This is Metric1
   2   | testing2 | This is Metric2

I'd like to add 2 worksheets after the ActiveSheet with the names "This is Metric1" and "This is Metric2", respectively (ideally, I'd like to populate cell A1 of each of the new worksheets with "testing1" and "testing2", respectively, as well- gotta walk before we can run though). I'm still relatively new to VBA, so please bare with my faulty code- this is what I've tried so far:

Sub test_tableTOtabs()
Dim fr As Integer
Dim lr As Integer
Dim col As String

fr = Application.InputBox("Starting row of data: ", , 2)
lr = Application.InputBox("Last row of data: ")
col = Application.InputBox("Column for Tab titles: ")

Dim BaseSheet As Worksheet
Set BaseSheet = ActiveSheet

Dim i As Integer
Dim TitleCell As String
Dim title As String
Dim ws As Worksheet

    For i = fr To lr
        Set TitleCell = col & CStr(i)
        title = ActiveSheet.Range("TitleCell").Value
        Set ws = Sheets.Add(After:=Sheets(Worksheets.Count))
            ws.Name = title
        Worksheets(BaseSheet).Activate
    Next

End Sub

I know that I am probably overcomplicating this, but I'm not sure how to get this done- please help!

People can't help if they don't understand the problem. Please use the **Edit** to specify your problem. — aaa, Mar 13 '18 at 00:04

DisplayName · Accepted Answer · 2018-03-13T11:43:23.290

your code had two main (and opposite!) flaws

use of a string with the name of a variable instead of the variable itself
```
title = ActiveSheet.Range("TitleCell").Value
```
should be
```
title = ActiveSheet.Range(TitleCell).Value
```
because "TitleCell" is just a string while TitleCell is a reference to a variable named after "TitleCell"
use of a variable instead of the of a string with the name of the variable itself
```
Worksheets(BaseSheet).Activate
```
should be
- either
```
Worksheets(BaseSheet.Name).Activate
```
  since Worksheets needs a string with the name of the worksheet to reference
- or
```
BaseSheet.Activate
```
  since BaseSheet is already a worksheet object reference itself

and then some minor flaws

with
```
Set ws = Sheets.Add(After:=Sheets(Worksheets.Count))
```
you most probably wanted to add new sheets at the end of your workbook

then you have to use
```
Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
```
because Worksheets.Count counts the items in the Worksheets collections, which doesn't include any Chart objects

while Sheets.Count counts the items in the Sheets collections, which include both Worksheet and Chart objects

weak use of Application.InputBox()

with

fr = Application.InputBox("Starting row of data: ", , 2)
lr = Application.InputBox("Last row of data: ")
col = Application.InputBox("Column for Tab titles: ")

you are not using a very handy feature of Application.InputBox() function which is the possibility of specifying theType of the value the user has to input

so you'd better use

fr = Application.InputBox("Starting row of data: ", Default:=2, Type:=1)' force a "numeric" user input 
lr = Application.InputBox("Last row of data: ", , Default:=2, Type:=1)' force a "numeric" user input 
col = Application.InputBox("Column for Tab titles: ", Default:="C", Type:=2)' force a "string" user input

where this latter is fairly important to your code which would subsequently use

 TitleCell = col & CStr(i)
 title = ActiveSheet.Range(TitleCell).value

i.e. it's assuming that col is a string column index and not a numeric one

use of Activate/Active/Select/Selection coding pattern

this is considered bad practice and you should use fully qualified range references to get full control of what your code is doing (it's quite easy to lose the actual "active" sheet when the code gets a little longer and/or you let the user do some sheet switching - like with Application.InputBox()) and improve code efficiency (no screen flickering)

so you may consider the following refactoring of your code (explanations in comments)

Sub test_tableTOtabs()
    Dim fr As Long, lr As Long
    Dim col As String
    Dim cell As Range

    fr = Application.InputBox("Starting row of data: ", Default:=2, Type:=1) 'force "numeric" user input
    With Worksheets("myBaseSheetName") ' reference your "base" sheet (change "myBaseSheetName" with the name of your actual "base" sheet)

        lr = Application.InputBox("Last row of data: ", , Default:=.Cells(.Rows.Count, 1).End(xlUp).Row, Type:=1) 'force "numeric" user input and give him referenced sheet column A last not empty row indeex as default
        col = Application.InputBox("Column for Tab titles: ", Default:=Split(Cells(1, Columns.Count).End(xlToLeft).Address, "$")(1), Type:=2) 'force "string" user input and give him referenced sheet row 1 last not empty column name as default

        For Each cell In Intersect(.Range(col & ":" & col), .Rows(fr & ":" & lr)) ' loop through referenced sheet column 'col' rows from 'fr' to 'lr'
            With Sheets.Add(After:=Sheets(Sheets.Count)) ' add and reference a new sheet at the end of the workbook
                .Name = cell.value ' rename referenced sheet after current cell value
                .Range("A1").value = cell.Offset(, -1) ' fill referenced sheet cell A1 with the content of the cell one column right of the current one
            End With
        Next
    End With
End Sub

This did not work, as the code I am trying to write should accomodate for any workbook- therefore BaseSheet will be a variable equal to the sheet active at the time the macro is run. — Matt G, Mar 13 '18 at 16:52
Then use `ActiveSheet` instead of `Worksheets("myBaseSheetName")`. let me know. — DisplayName, Mar 13 '18 at 17:26

score 0 · Answer 2 · answered Mar 13 '18 at 16:55

Solved:

Sub tableTOtabs3()
Application.ScreenUpdating = False
Dim fr As Integer
Dim lr As Integer
Dim col As String
Dim val1 As String
Dim val2 As String

fr = Application.InputBox("Starting row of data: ", Default:=2, Type:=1)
lr = Application.InputBox("Last row of data: ", , Default:=2, Type:=1)
col = Application.InputBox("Column for Tab titles: ", Default:="A", Type:=2)
val1 = Application.InputBox("Column for Value start: ", Default:="B", Type:=2)
val2 = Application.InputBox("Column for Value end: ", Default:="C", Type:=2)

Dim BaseSheet As Worksheet
Set BaseSheet = ActiveSheet

Dim i As Integer
Dim TitleCell As String
Dim title As String
Dim ws As Worksheet
Dim x As Integer

    For i = fr To lr
        On Error Resume Next

        TitleCell = CStr(col & CStr(i))
        title = Left(Replace(CStr(ActiveSheet.Range(TitleCell).Value), "/", "_"), 30)
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
        ws.Name = title
            If Err.Number <> 0 Then
                MsgBox "Error on Title: " & Chr(34) & title & Chr(34) & "  (Row: " & i & ")"
            End If
                For x = ToColNum(val1) To ToColNum(val2)
                        'add headers if they exist
                        If fr > 1 Then
                            BaseSheet.Cells(1, x).Copy
                            ws.Cells(1, x).PasteSpecial Paste:=xlPasteFormats
                            ws.Cells(1, x).PasteSpecial Paste:=xlPasteValues
                        End If
                    BaseSheet.Cells(i, x).Copy
                    ws.Cells(fr, x).PasteSpecial Paste:=xlPasteFormats
                    ws.Cells(fr, x).PasteSpecial Paste:=xlPasteValues
                Next
            ws.Cells(1, 1).Select
        BaseSheet.Select
    Next
BaseSheet.Cells(1, 1).Select
Application.ScreenUpdating = True
End Sub

I saw you amended your code as per my solution. Please, as per this site rules, consider marking my answer as accepted. Thank you — DisplayName, Mar 13 '18 at 18:58

Add named worksheets using For Loop

2 Answers2

Solved: