Make a new Excel file based on a table's row while also copying into the new file the corresponding row of the table's value

Question

Looking to fill a "Template" sheet based on a row/table's info and save as individual sheets.

Worksheet "DataSource" layout is Columns A-AB (headers in row1)

The goal is that for each "IB#" (column B), populate a template based on the "IB#" row's information and generates a new Excel file per IB#.

----------------UPDATE!!!----------------

I was able to do it. How can I optimize part 2 (Filling The Template)?

Sub AAA_Refresh_Temp()
'1) I was generating a new sheet per IB

    Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
    Set sh1 = Sheets("Template")
    Set sh2 = Sheets("CommStat")
    For Each c In sh2.Range("B2", sh2.Cells(Rows.Count, 2).End(xlUp))
        sh1.copy After:=Sheets(Sheets.Count)
        ActiveSheet.name = c.Value
        ActiveSheet.Range("A9") = "'" & ActiveSheet.name
'(A9 is where I filled the IB number so that every time A9 is different,
' it populates the rest of the chart/template)

'2) Filling The Template
'-------I am trying to optimize the following part:-------

        Call AAA_Fill_Temp
        With Sheets("CommStat")
            Sheets("CommStat").Range("B2", .Range("B2").End(xlDown)).name = "IB_Accounts"
            Sheets("CommStat").Range("C2", .Range("C2").End(xlDown)).name = "IB_Information"
            Sheets("CommStat").Range("AA2", .Range("AA2").End(xlDown)).name = "IB_Adress1"
            Sheets("CommStat").Range("AB2", .Range("AB2").End(xlDown)).name = "IB_Adress2"
            Sheets("CommStat").Range("D2", .Range("D2").End(xlDown)).name = "ColD"
            Sheets("CommStat").Range("E2", .Range("E2").End(xlDown)).name = "ColE"
            Sheets("CommStat").Range("F2", .Range("F2").End(xlDown)).name = "ColF"
            Sheets("CommStat").Range("G2", .Range("G2").End(xlDown)).name = "ColG"
            Sheets("CommStat").Range("H2", .Range("H2").End(xlDown)).name = "ColH"
            Sheets("CommStat").Range("I2", .Range("I2").End(xlDown)).name = "ColI"
            Sheets("CommStat").Range("J2", .Range("J2").End(xlDown)).name = "ColJ"
            Sheets("CommStat").Range("K2", .Range("K2").End(xlDown)).name = "ColK"
            'Sheets("CommStat").Range("K2", .Range("K2").End(xlDown)).name = "ColL"
            Sheets("CommStat").Range("M2", .Range("M2").End(xlDown)).name = "ColM"
            Sheets("CommStat").Range("N2", .Range("N2").End(xlDown)).name = "ColN"
            Sheets("CommStat").Range("O2", .Range("O2").End(xlDown)).name = "ColO"
            Sheets("CommStat").Range("P2", .Range("P2").End(xlDown)).name = "ColP"
            Sheets("CommStat").Range("Q2", .Range("Q2").End(xlDown)).name = "ColQ"
            Sheets("CommStat").Range("R2", .Range("R2").End(xlDown)).name = "ColR"
            Sheets("CommStat").Range("S2", .Range("S2").End(xlDown)).name = "ColS"
            Sheets("CommStat").Range("T2", .Range("T2").End(xlDown)).name = "ColT"
            'Sheets("CommStat").Range("U2", .Range("U2").End(xlDown)).name = "ColU"
            'Sheets("CommStat").Range("V2", .Range("V2").End(xlDown)).name = "ColV"
            'Sheets("CommStat").Range("W2", .Range("W2").End(xlDown)).name = "ColW"
            'Sheets("CommStat").Range("X2", .Range("X2").End(xlDown)).name = "ColX"
            'Sheets("CommStat").Range("Y2", .Range("Y2").End(xlDown)).name = "ColY"
            'Sheets("CommStat").Range("Z2", .Range("Z2").End(xlDown)).name = "ColZ"
        End With
    Next
End Sub

Sub AAA_Fill_Temp()
    Dim bottom As String
    bottom = Range("A9").End(xlDown).Address
    bottom = Replace(bottom, "$A$", "")
    'Sheets("Test").Range("E4:E" & bottom).Formula = "=IFERROR(LOWER(INDEX(IB_Information, MATCH(C4, IB_Accounts,0),2)), ""Missing"")"
    'Sheets("Test").Range("F4:F" & bottom).Formula = "=IFERROR(PROPER((INDEX(IB_Information,MATCH(C4,IB_Accounts,0),1))), ""Missing"")"
'    >> Fills The Name and Address1&2
    ActiveSheet.Range("A11:A11").Formula = "=IFERROR(PROPER(INDEX(IB_Information, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
    ActiveSheet.Range("A12:A12").Formula = "=IFERROR(UPPER(INDEX(IB_Adress, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
    ActiveSheet.Range("A13:A13").Formula = "=IFERROR(UPPER(INDEX(IB_Adress2, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
'    >> Fills The Columns D-K
    ActiveSheet.Range("B22:B22").Formula = "=IFERROR((INDEX(ColD, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B23:B23").Formula = "=IFERROR((INDEX(ColE, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B24:B24").Formula = "=IFERROR((INDEX(ColF, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B25:B25").Formula = "=IFERROR((INDEX(ColG, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B26:B26").Formula = "=IFERROR((INDEX(ColH, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B27:B27").Formula = "=IFERROR((INDEX(ColI, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B28:B28").Formula = "=IFERROR((INDEX(ColJ, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("B29:B29").Formula = "=IFERROR((INDEX(ColK, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
'    .Range("B22:B22").Formula = "=IFERROR((INDEX(ColL, MATCH($A$9, IB_Accounts,0),1)), "" - "")"

'    >> Fills The Columns M-Z
    ActiveSheet.Range("C22:C22").Formula = "=IFERROR((INDEX(ColM, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C23:C23").Formula = "=IFERROR((INDEX(ColN, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C24:C24").Formula = "=IFERROR((INDEX(ColO, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C25:C25").Formula = "=IFERROR((INDEX(ColP, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C26:C26").Formula = "=IFERROR((INDEX(ColQ, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C27:C27").Formula = "=IFERROR((INDEX(ColR, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C28:C28").Formula = "=IFERROR((INDEX(ColS, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    ActiveSheet.Range("C29:C29").Formula = "=IFERROR((INDEX(ColT, MATCH($A$9, IB_Accounts,0),1)), "" - "")"

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Please explain what you're trying to do in that part of the code. Does it (assign the name to the range) apply to the duplicated sheet? you're looping through the cells in the template, but repeating the name assignment to the commstat sheet — Ricardo Diaz, Jan 31 '20 at 23:35

score 0 · Answer 1 · answered Feb 01 '20 at 00:05

Remarks:

This is an untested solution
If you provide some sample data/workbook, would be easier
Backup your data before trying it
The AAA_Fill_Temp can be further optimized
Even though is more code, it follows some good practices and tries to organize what's happening inside yours

Let me know the results...

Code

Option Explicit

Public Sub GenerateSheets()

    Dim templateSheet As Worksheet
    Dim commStatSheet As Worksheet
    Dim targetSheet As Worksheet

    Dim sourceRange As Range
    Dim cell As Range

    Dim lastRow As Long

    Set templateSheet = ThisWorkbook.Worksheets("Template")
    Set commStatSheet = ThisWorkbook.Worksheets("CommStat")

    lastRow = commStatSheet.Cells(commStatSheet.Rows.Count, "B").End(xlUp).Row

    Set sourceRange = commStatSheet.Range("B2:B" & lastRow)

    For Each cell In sourceRange.Cells

        Set targetSheet = DuplicateSheet(templateSheet.Name, cell.Value)

        targetSheet.Name = cell.Value
        targetSheet.Range("A9").Value = "'" & targetSheet.Name

    Next cell

End Sub

Private Sub prepareCommStatSheet(ByVal commStatSheet As Worksheet)

    Dim columnList As String
    Dim columnArray As Variant

    Dim startRow As Long
    Dim lastRow As Long
    Dim counter As Long

    startRow = 2
    columnList = "B,C,AA,AB,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T"

    columnArray = Split(columnList, ",")

    ' Assign name to columns whose name doesn't correspond to the column letter

    assignNameToRange commStatSheet, "B", "IB_Accounts", startRow
    assignNameToRange commStatSheet, "C", "IB_Information", startRow
    assignNameToRange commStatSheet, "AA", "IB_Adress1", startRow
    assignNameToRange commStatSheet, "AB", "IB_Adress2", startRow

    For counter = 0 To UBound(columnArray)

        With commStatSheet

            assignNameToRange commStatSheet, columnArray(counter), "col" & columnArray(counter), startRow

        End With

    Next counter

End Sub

Private Sub assignNameToRange(ByVal targetSheet As Worksheet, ByVal targetColumn As String, ByVal targetName As String, ByVal startRow As Long)

    Dim lastRow As Long

    lastRow = targetSheet.Cells(targetSheet.Rows.Count, targetColumn).End(xlUp).Row
    targetSheet.Range(targetColumn & startRow & ":" & targetColumn & lastRow).Name = targetName

End Sub

Private Sub fillTargetSheet(ByVal targetSheet As Worksheet)

    With targetSheet
'    >> Fills The Name and Address1&2
        .Range("A11:A11").Formula = "=IFERROR(PROPER(INDEX(IB_Information, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
        .Range("A12:A12").Formula = "=IFERROR(UPPER(INDEX(IB_Adress, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
        .Range("A13:A13").Formula = "=IFERROR(UPPER(INDEX(IB_Adress2, MATCH($A$9, IB_Accounts,0),1)), ""Missing"")"
'    >> Fills The Columns D-K
        .Range("B22:B22").Formula = "=IFERROR((INDEX(ColD, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B23:B23").Formula = "=IFERROR((INDEX(ColE, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B24:B24").Formula = "=IFERROR((INDEX(ColF, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B25:B25").Formula = "=IFERROR((INDEX(ColG, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B26:B26").Formula = "=IFERROR((INDEX(ColH, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B27:B27").Formula = "=IFERROR((INDEX(ColI, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B28:B28").Formula = "=IFERROR((INDEX(ColJ, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("B29:B29").Formula = "=IFERROR((INDEX(ColK, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
'    .Range("B22:B22").Formula = "=IFERROR((INDEX(ColL, MATCH($A$9, IB_Accounts,0),1)), "" - "")"

'    >> Fills The Columns M-Z
        .Range("C22:C22").Formula = "=IFERROR((INDEX(ColM, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C23:C23").Formula = "=IFERROR((INDEX(ColN, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C24:C24").Formula = "=IFERROR((INDEX(ColO, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C25:C25").Formula = "=IFERROR((INDEX(ColP, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C26:C26").Formula = "=IFERROR((INDEX(ColQ, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C27:C27").Formula = "=IFERROR((INDEX(ColR, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C28:C28").Formula = "=IFERROR((INDEX(ColS, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
        .Range("C29:C29").Formula = "=IFERROR((INDEX(ColT, MATCH($A$9, IB_Accounts,0),1)), "" - "")"
    End With

End Sub


Public Function DuplicateSheet(ByVal sheetSourceName As String, ByVal sheetTargetName As String) As Worksheet

    ' Credits: https://stackoverflow.com/a/58661151/1521579

    Dim newSheet As Worksheet
    Dim position As Long

    position = GetFirstVisiblePostion

    ThisWorkbook.Worksheets(sheetSourceName).Copy Before:=ThisWorkbook.Sheets(position)

    Set newSheet = ThisWorkbook.Sheets(position)

    newSheet.Name = sheetTargetName

    Set DuplicateSheet = newSheet

End Function

Private Function GetFirstVisiblePostion() As Long
    ' Credits: https://stackoverflow.com/a/58661151/1521579
    Dim wbSheet As Worksheet
    Dim position As Long
    For Each wbSheet In ThisWorkbook.Sheets
        If wbSheet.Visible = xlSheetVisible Then
            position = wbSheet.Index
            Exit For
        End If
    Next
    GetFirstVisiblePostion = position
End Function

Ricardo, Thanks you for your detailed answer! It is working significantly faster. It is generating the sheets and filling A9, but it is not inserting the formulas to auto-fill (based on A9 & Template) the made sheets. It seems that "fillTargetSheet" is not getting implemented properly. — Pepe, Feb 03 '20 at 15:49

Make a new Excel file based on a table's row while also copying into the new file the corresponding row of the table's value

1 Answers1

Remarks: