Script needed - Create sheet from row data

[jhndeere]

Looking for a script that will create a new worksheet based on information found in a row on Sheet1 "Main Data". Then populate the worksheets with data from "Main Data" into specific cells and finally renaming the sheet.

Key data locations.

• The main sheet with all of the data is titled "Main Data". All of the data that should be used to create the new sheets is organized into a row. There are about 7,000 rows of data, with each row having about 25 columns to transfer over.
• The sheets created need to be a copy of a worksheet already created, named "Template". This sheet has headers, column widths, formats, etc.. already designed the way we want it to look along with the necessary headings.
• Once created the sheet name would be renamed to match the text in Column A on every row.
• The data in the rows on the Main Data sheet is copied to the newly created sheet to a specific location.
  • Column B goes to A2
  • Column C goes to E4
  • Column E goes to F19
  • and so on, but I think I could figure out the pattern if I was shown 2.

I hope that is clear and the community is able to create one to do this.

Thanks in advance.
-j

 

[Dan_W]

I think I understand:

1. The sheet, "Main Data", has the data in it - approx 7,000 entries (or rows).
2. The data in each of these rows need to be copied over to their own worksheet, which itself is just a copy of the worksheet, "Template". Is "Template in the same workbook as "Main Data"?
3. If, for example, the current row of data being processed is Row 20, then the name of the new worksheet can be found at Cell A20.
4. And then, on this new worksheet:-
- cell A2 comes from the Main Data cell B20;
- cell E4 comes from the Main Data cell C20,
and so forth?
5. So ultimately, are you then looking to create around 7,000 sheets? Will these worksheets meant to be in the same workbook?

 

[mumps]

Doing what you asked is certainly possible but I think you would have to ask yourself why you need 7000 sheets in a workbook. This would take up a lot of memory (RAM) on your computer which would affect the running of Excel and any other programs you might be using at the same time. I would imagine that a workbook of this size would be extremely hard to manage.

 

[Dan_W]

Mumps is absolutely right. It is certainly possible (and actually, really quite simple to code), but the more critical issue is whether your computer could handle the consequences. I can tell you, from personal experience, that I once left my computer to consolidate a folder of excel workbooks containing (what I thought was about) a dozen files. Turns out there was actually around two hundred workbooks in that folder, and so I came back to discover a consolidated workbook of 1800 sheets. My computer effectively grinded to a halt, and it took me a while to break it down into smaller files because Excel kept crashing..

Could each row/entry be it's own 1-sheet workbook instead?

 

[jhndeere]

Could each row/entry be it's own 1-sheet workbook instead?

Yes, taking everyone's advice on here I broke it down into 7 workbooks with 1000 sheets each. My PC was able to handle that with no problem.

As for the script, you are probably right about it being simple, but I wasn't able to figure it out and was up against a pretty tight timeline. I paid someone over the weekend to write the code and looking at what they wrote it makes sense and is straight forward.

-J

 

[jhndeere]

Here is what I ended up using, mabye it will help someone else in the future.

Option Explicit
Function getLastUsedRow(ws As Worksheet) As Long

    Dim lastUsedRow As Long: lastUsedRow = 1
    On Error Resume Next
        lastUsedRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    On Error GoTo 0
    
    getLastUsedRow = lastUsedRow

End Function
Function checkIfWorksheetExists(wb As Workbook, wsName As String) As Boolean

    Dim i As Long
    Dim found As Boolean
    
    found = False
    
    For i = 1 To wb.Worksheets.Count
    
        If Trim(wb.Worksheets(i).Name) = Trim(wsName) Then
        
            found = True
            Exit For
        
        End If
    
    Next i
    
    checkIfWorksheetExists = found

End Function
Sub GENERATE_SHEETS_BASED_ON_TEMPLATE()
    
    ' -----------------------------------------------------------------------------------------------
    ' First we check if RUN worksheet exist, if it doesn't we exit the code !
    ' -----------------------------------------------------------------------------------------------
    If Not checkIfWorksheetExists(ThisWorkbook, "RUN") Then
        MsgBox "Please create 'RUN' sheet, and run this macro again!", vbExclamation
        Exit Sub
    End If
    
    ' -----------------------------------------------------------------------------------------------
    ' Next we check if Summary worksheet exist, if it doesn't we exit the code !
    ' -----------------------------------------------------------------------------------------------
    If Not checkIfWorksheetExists(ThisWorkbook, "Summary") Then
        MsgBox "Please create 'Summary' sheet, and run this macro again!", vbExclamation
        Exit Sub
    End If
    
    ' -----------------------------------------------------------------------------------------------
    ' Next we check if Template worksheet exist, if it doesn't we exit the code !
    ' -----------------------------------------------------------------------------------------------
    If Not checkIfWorksheetExists(ThisWorkbook, "Template") Then
        MsgBox "Please create 'Template' sheet, and run this macro again!", vbExclamation
        Exit Sub
    End If
    
    Dim i As Long
    Dim j As Long
    Dim k As Long
    
    Application.ScreenUpdating = False
    
    ' --------------------------------------------------------------------------------------------
    ' --------------------------- VARIABLES FOR SUMMARY WORKSHEET ! ------------------------------
    ' --------------------------------------------------------------------------------------------
    Dim wsSummary As Worksheet: Set wsSummary = ThisWorkbook.Worksheets("Summary")
    Dim wsSummaryStartingRow As Long: wsSummaryStartingRow = 2 ' Starting row, first is header row !
    Dim wsSummaryEndingRow As Long: wsSummaryEndingRow = getLastUsedRow(wsSummary) + 10 ' Ending row !
    
    Dim wsSummaryCurrentSheetName As String
    
    ' --------------------------------------------
    ' Loop through all rows in Summary sheet !
    ' --------------------------------------------
    For i = wsSummaryStartingRow To wsSummaryEndingRow
        
        ' ----------------------
        ' Reset variables !
        ' ----------------------
        wsSummaryCurrentSheetName = ""
        
        ' ----------------------
        ' Extract variables !
        ' ----------------------
        wsSummaryCurrentSheetName = Trim(wsSummary.Range("A" & CStr(i)).Value2)
        
        ' -----------------------
        ' Skip empty values !
        ' -----------------------
        If wsSummaryCurrentSheetName <> "" Then
            
            ' -----------------------------------------------------------------------------
            ' Next if the sheet doesn't exists already, generate it based on template !
            ' -----------------------------------------------------------------------------
            If Not checkIfWorksheetExists(ThisWorkbook, wsSummaryCurrentSheetName) Then
                
                ' -----------------------------------
                ' Create a copy of the template !
                ' -----------------------------------
                ThisWorkbook.Worksheets("Template").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
                ActiveSheet.Name = wsSummaryCurrentSheetName
                
                ' ---------------------------------------------------------------------------
                ' Fill the copy of the Template sheet, with values from the current row !
                ' ---------------------------------------------------------------------------
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("A7").Value2 = wsSummary.Range("A" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("G8").Value2 = wsSummary.Range("B" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("B8").Value2 = wsSummary.Range("C" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("B7").Value2 = wsSummary.Range("D" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("G7").Value2 = wsSummary.Range("E" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("H7").Value2 = wsSummary.Range("F" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("I7").Value2 = wsSummary.Range("G" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("J7").Value2 = wsSummary.Range("H" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("L7").Value2 = wsSummary.Range("I" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("K7").Value2 = wsSummary.Range("J" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("M7").Value2 = wsSummary.Range("K" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("N7").Value2 = wsSummary.Range("L" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("O7").Value2 = wsSummary.Range("M" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("R7").Value2 = wsSummary.Range("N" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("T7").Value2 = wsSummary.Range("O" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("H82").Value2 = wsSummary.Range("P" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("I82").Value2 = wsSummary.Range("Q" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("J82").Value2 = wsSummary.Range("R" & CStr(i)).Value2
                ThisWorkbook.Worksheets(wsSummaryCurrentSheetName).Range("Q7").Value2 = wsSummary.Range("S" & CStr(i)).Value2
                
            End If
            
        
        End If
    
    Next i
    
    ' ----------------------------
    ' Activate the RUN sheet !
    ' ----------------------------
    ThisWorkbook.Worksheets("RUN").Activate
    
    ' -----------------------------
    ' Remove unused variables !
    ' -----------------------------
    Set wsSummary = Nothing
    
    Application.ScreenUpdating = True
    
    ' ------------------------------------------------
    ' Inform the user that process was completed !
    ' ------------------------------------------------
    MsgBox "Done!", vbInformation

End Sub