create sheet from 'template' sheet and rename as list in 'master' sheet

[Donerightdata]

Hi Excel Gods!
I have been at this for days but think I have bitten off way more than I can chew. I was hoping someone here will be better at this than me. I have a master list (it is huge!) with rows of data from testing each piece of equipment which I then need to create separate sheets (in the same workbook) from a template which is the form to be filled from each row of data. It seems complicated so I will list the steps:

1. Hit a button to create new sheets which copies the 'template' sheet in a workbook and names it the same as each entry in column E of the 'master' sheet. (this I can get to work in a very simple way)
2. Use maybe a formula in certain cells on each created sheet (which would ideally be in the template and copied in each created sheet) to look up the name of the sheet and fill the data from that row on the 'master' into the cells of the form. (This I can't seem to do at all)

If I could get it to do this just one time at the completion of the master that would get me out of trouble but....
What I would really love is to be able to hit the create button and have it check column E on 'master' with the already created sheets and ignore if it exists or create a new sheet from the template if it doesn't. (This is where dreams are made!) I would also like it to ignore any blanks in Column E when creating the sheets but can manually remove them if this is too complicated.

The first screen shot shows the start of the data in the 'master' with column E being what I want each new sheet named (they are all unique).
The second screen shot shows the start of the form with the columns of the 'master' referenced.

So essentially the logic for the fill form would go IF <sheetname> = row1 in Column E then copy data from cell E1 to cell marked colum:E in that sheet. Then for the next field IF <sheetname> = row1 in Column E then copy data from cell F1 to cell marked colum:F in that sheet. I think the merged cells in 'template' might be giving me some grief but I can't really unmerge them and make the form look any good. There is 425 columns and about 360 rows in total so I am worried that too many lookup type formulas will make it REALLY slow. It may also be possible for the form to fill as the sheet is created using the VBA but that is WAY beyond me.

This will save me WEEKS of manual data transfer (and my sanity) so any help you can give will be VERY appreciated.

 

[linkin_anytime]

Something to get you started. See if this is something similar to what you're looking for in the link below.

Sample file

Sub Create()
    Dim rng As Range, rngLoop As Range, ws As Worksheet
    
    Application.ScreenUpdating = False
    
    With ActiveWorkbook.Sheets("Master")
        Set rng = .Range("D2", "D" & .Cells(Rows.Count, "D").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlTextValues)
            
        For Each rngLoop In rng
            If Not SheetExists(rngLoop.Value) Then
                Set ws = ActiveWorkbook.Worksheets.Add(after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
                ws.Name = rngLoop.Value
            Else
                Set ws = ActiveWorkbook.Sheets(rngLoop.Value)
            End If
            ws.Range("A1").Resize(, 11).Value = .Range("A1:K1").Value
            ws.Range("A" & ws.Range("A1").End(xlUp).Row + 1).Resize(, 11).Value = .Range(.Cells(rngLoop.Row, 1), .Cells(rngLoop.Row, 11)).Value
        Next
        .Activate
    End With
    
    Application.ScreenUpdating = True
End Sub

Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
   Dim sht As Worksheet

    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    Set sht = wb.Sheets(shtName)
    On Error GoTo 0
    SheetExists = Not sht Is Nothing
End Function

 

[Donerightdata]

Hi Linkin - Wow this is a lot closer than I got and a quick response - Thank you so much! I would really like to understand this better.

With ActiveWorkbook.Sheets("Master")
Set rng = .Range("D2", "D" & .Cells(Rows.Count, "D").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlTextValues)

I have updated the above to the following to use column E which contains a concanenate formula and it works as intended:

With ActiveWorkbook.Sheets("Master")
Set rng = .Range("E2", "E" & .Cells(Rows.Count, "E").End(xlUp).Row).SpecialCells(xlCellTypeFormulas, xlTextValues)

However I am not sure how to fit the copying of the template into your code. The code I used to create and copy the template (way to simple and no checks) is:

Sub CreateSheetsFromList()
Dim ws As Worksheet, Ct As Long, c As Range
Set ws = Worksheets("Template")
Application.ScreenUpdating = False
For Each c In Sheets("Master").Range("E2:E25")
    If c.Value <> "" Then
        ws.Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = c.Value
        Ct = Ct + 1
    End If
Next c
If Ct > 0 Then
    MsgBox Ct & " new sheets created from list"
Else
    MsgBox "No names on list"
End If
Application.ScreenUpdating = True
End Sub

The message box stuff was a nice to have (and only there because I knew how to do it) and I dont really care if it is not there. Now that I have seen how your code works I was thinking it should be easy to copy just the 1 line of data like your code does into row 130 of the created template sheet then just use an =cell(X) formula in the template sheet to match that data to the correct field in the form.

Any chance you could help me change this bit:

For Each rngLoop In rng
            If Not SheetExists(rngLoop.Value) Then
                Set ws = ActiveWorkbook.Worksheets.Add(after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
                ws.Name = rngLoop.Value

to create the new sheet from the template sheet and copy the row from the 'master' to row 130 of the created sheet?

We are so close I can feel the next 3 weeks becoming less stressful already! Thanks so much for your time Linkin!!!

 

[linkin_anytime]

I'm glad we're getting close. I have updated the code below to create the new sheet from the Template sheet and copy the row from the Master to the fixed row 130 on the created tab. I also included a quick check at the beginning of the Sub to ensure the Template sheet exists before copying. Also want to note that the code is currently set for a range of data from Col A to Col K, hence fixed column number 11 in the code. Feel free to change accordingly to suit your need. Let me know if this is what you're looking for.

Sub Create()
    Dim rng As Range, rngLoop As Range, ws As Worksheet
    
    If Not SheetExists("Template") Then
        MsgBox "The Template sheet does not exist. Make sure the Template is included before processing.", vbCritical + vbOKOnly
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    With ActiveWorkbook.Sheets("Master")
        Set rng = .Range("D2", "D" & .Cells(Rows.Count, "D").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlTextValues)
            
        For Each rngLoop In rng
            If Not SheetExists(rngLoop.Value) Then
                ActiveWorkbook.Sheets("Template").Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
                Set ws = ActiveSheet
                ws.Name = rngLoop.Value
            Else
                Set ws = ActiveWorkbook.Sheets(rngLoop.Value)
            End If
            ws.Range("A1").Resize(, 11).Value = .Range("A1:K1").Value
            ws.Range("A130").Resize(, 11).Value = .Range(.Cells(rngLoop.Row, 1), .Cells(rngLoop.Row, 11)).Value
        Next
        .Activate
    End With
    
    Application.ScreenUpdating = True
End Sub

 

[Donerightdata]

Thanks Linkin. I am learning heaps from this exercise. I fully understand what you mean with changing the range and fixed column number.
I have used the previous 'sheet exists' function but there is one strange result which I think either has to do with this function or the active worksheet setting when copying in the data to row 130. It seem to also copy cell A1 from the 'master' into cell A1 of each created template (see screen shots of template before and after running VBA).

Stepping through the code it happens upon executing line 22

ws.Range("B1").Resize(, 11).Value = .Range("B1:K1").Value

and I think it has to do with the 'SheetExists' function which in the original code was designed to check the tab names before creating a new one and not creating a second one if it already exists but is now also used in Line 4 to check the template exists before anything else. If you have time to have a look and show me where I am going wrong that would be awesome!

Sub Create()
    Dim rng As Range, rngLoop As Range, ws As Worksheet

    If Not SheetExists("Template") Then
        MsgBox "The Template sheet does not exist. Make sure the Template is included before processing.", vbCritical + vbOKOnly
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    With ActiveWorkbook.Sheets("Master")
        Set rng = .Range("E2", "E" & .Cells(Rows.Count, "E").End(xlUp).Row).SpecialCells(xlCellTypeFormulas, xlTextValues)
            
        For Each rngLoop In rng
            If Not SheetExists(rngLoop.Value) Then
                ActiveWorkbook.Sheets("Template").Copy after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
                Set ws = ActiveSheet
                ws.Name = rngLoop.Value
            Else
                Set ws = ActiveWorkbook.Sheets(rngLoop.Value)
            End If
            ws.Range("B1").Resize(, 11).Value = .Range("B1:K1").Value
            ws.Range("A130").Resize(, 11).Value = .Range(.Cells(rngLoop.Row, 1), .Cells(rngLoop.Row, 11)).Value
        Next
        .Activate
    End With
    
    Application.ScreenUpdating = True
End Sub

Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
   Dim sht As Worksheet

    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    Set sht = wb.Sheets(shtName)
    On Error GoTo 0
    SheetExists = Not sht Is Nothing
End Function

 

[linkin_anytime]

You can actually remove the line below. I originally had it in the sample to copy the header line over each individual tab. Now since you're using the Template, you don't need this step. The SheetExists function should be ok. Remove the line and let me know if you have any issue.

ws.Range("B1").Resize(, 11).Value = .Range("B1:K1").Value

 

[Donerightdata]

And you are a master of the art and my NEW FAVOURITE PERSON in the whole world!

This appears to do everything I need. I am going to play with the full scope of what I want it to do and will let you know!
I really don't know how to thank you enough for saving me weeks of works!

 

[linkin_anytime]

You're welcome. If it solves your issue, please feel free to mark the thread as solved.

 

[Donerightdata]

It is truly magical to watch. I just tested it on the file with 360 rows and 425 columns and everything came across exactly as it should. The help you gave has increased my knowledge and turned an utterly mind numbing task into the press of a button with NO ERRORS!

I really can't thank you enough and have marked this thread as solved. I hope it can help someone else in the future!

Cheers @linkin_anytime

 

[linkin_anytime]

Thanks for the feedback. Glad I was able to help. Cheers!