CODEWITHSUNDEEP
excelvba
Bobby
Bobby

Reputation: 1

Populating new templates based on information in a list

Excel starts with two sheets.
First a list which includes data for a name, a number, and a product numbers.
The second tab is a template.

I'm trying to:
Copy the template tab, input the name, number, and product into the new tab, and then rename the tab (ActiveSheet.Name = Range("B3").Value).
Loop down to the next row and repeat until there are no more rows.
If a tab already exists with the name, then move onto the next row.

I tried two methods.

The code below I could probably figure out but it would require me to copy and paste the same lines with updated rows about 100 times since it isn't looping.
Also, the macro stops if there's already a tab with the name on it instead of continuing.

I made several attempts to have the macro move on if a tab has already been created from a name on the list but this keeps breaking the macro.

Sub TemplateMultiple()
'
' Tab creation and naming
'

'
    Sheets("Template").Select
    Sheets("Template").Copy Before:=Sheets(2)
    Range("B3:C3").Select
    ActiveCell.FormulaR1C1 = "='List'!R[2]C"
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "='List'!RC[3]"
    Range("B6:C6").Select
    ActiveCell.FormulaR1C1 = "='List'!R[-1]C[4]"
    Range("B7:C7").Select
    ActiveSheet.Name = Range("B3").Value
    
    Sheets("Template").Select
    Sheets("Template").Copy Before:=Sheets(3)
    Range("B3:C3").Select
    ActiveCell.FormulaR1C1 = "='List'!R[3]C"
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "='List'!R[2]C[3]"
    Range("B6:C6").Select
    ActiveCell.FormulaR1C1 = "='List'!R[0]C[4]"
    Range("B7:C7").Select
    ActiveSheet.Name = Range("B3").Value
    
    Sheets("Template").Select
    Sheets("Template").Copy Before:=Sheets(4)
    Range("B3:C3").Select
    ActiveCell.FormulaR1C1 = "='List'!R[4]C"
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "='List'!R[2]C[3]"
    Range("B6:C6").Select
    ActiveCell.FormulaR1C1 = "='List'!R[1]C[4]"
    Range("B7:C7").Select
    ActiveSheet.Name = Range("B3").Value
    
    Sheets("Template").Select
    Sheets("Template").Copy Before:=Sheets(5)
    Range("B3:C3").Select
    ActiveCell.FormulaR1C1 = "='List'!R[5]C"
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "='List'!R[3]C[3]"
    Range("B6:C6").Select
    ActiveCell.FormulaR1C1 = "='List'!R[2]C[4]"
    Range("B7:C7").Select
    ActiveSheet.Name = Range("B3").Value
    
    Sheets("Template").Select
    Sheets("Template").Copy Before:=Sheets(6)
    Range("B3:C3").Select
    ActiveCell.FormulaR1C1 = "='List'!R[6]C"
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "='List'!R[4]C[3]"
    Range("B6:C6").Select
    ActiveCell.FormulaR1C1 = "='List'!R[3]C[4]"
    Range("B7:C7").Select
    ActiveSheet.Name = Range("B3").Value
End Sub

The second method involves a loop to make the code much easier to read/follow.
My code is putting the same information into each template instead of going down one row for each spreadsheet.

Sub Template1()
'UpdatebyExtendoffice20161222
    Dim x As Integer
    Application.ScreenUpdating = False
    ' Set numrows = number of rows of data.
    NumRows = Range("B5", Range("B5").End(xlDown)).Rows.Count
    ' Select cell a1.
    Range("B5").Select
    ' Establish "For" loop to loop "numrows" number of times.
    For x = 1 To NumRows
        ' Insert your code here.
        Sheets("Template").Select
        Sheets("Template").Copy Before:=Sheets(2)
        Range("B3:C3").Select
        ActiveCell.FormulaR1C1 = "='List'!R[2]C"
        Range("B5:C5").Select
        ActiveCell.FormulaR1C1 = "='List'!RC[3]"
        Range("B6:C6").Select
        ActiveCell.FormulaR1C1 = "='List'!R[-1]C[4]"
        Range("B7:C7").Select
        ActiveSheet.Name = Range("B3").Value
        ' Selects cell down 1 row from active cell.
        ActiveCell.Offset(1, 0).Select
    Next
    Application.ScreenUpdating = True
End Sub

Upvotes: 0

Views: 216

Answers (1)

Tim Williams
Tim Williams

Reputation: 166316

Something like this should work:

Sub Template1()

    Dim wb As Workbook, ws As Worksheet, wsList As Worksheet
    Dim c As Range, sheetName As String, wsTempl As Worksheet
    
    Set wb = ThisWorkbook
    Set wsList = wb.Worksheets("List")
    Set wsTempl = wb.Worksheets("Template")
    
    Application.ScreenUpdating = False
    
    For Each c In wsList.Range("B5", wsList.Cells(Rows.Count, "B").End(xlUp)).Cells
        sheetName = c.Value
        Set ws = GetWorksheet(wb, sheetName) 'see if there's an existing sheet with this name
        If ws Is Nothing Then                'if was no matching sheet
            wsTempl.Copy before:=wsTempl     'copy template in front of itself
            Set ws = wb.Worksheets(wsTempl.Index - 1) 'get a reference to the copy
            ws.Name = sheetName
            With c.EntireRow
                'I never use R1C1 so this might be off...
                ws.Range("B3:C3").Formula = "='List'!" & .Columns("B").Address(False, False)
                ws.Range("B5:C5").Formula = "='List'!" & .Columns("E").Address(False, False)
                ws.Range("B6:C6").Formula = "='List'!" & .Columns("E").Address(False, False)
            End With
        End If
    Next c
    
    Application.ScreenUpdating = True
End Sub

'Return a worksheet named `wsName` from workbook `wb`, or `Nothing` if it doesn't exist
Function GetWorksheet(wb As Workbook, wsName As String) As Worksheet
    On Error Resume Next
    Set GetWorksheet = wb.Worksheets(wsName)
    On Error Goto 0
End Function

Note there's rarely any need to select/activate things before you work with them - that's an artifact of the macro recorder. See How to avoid using Select in Excel VBA for more on this and some good guidelines to follow.

Upvotes: 1

Related Questions