CODEWITHSUNDEEP
vbaexcel
Nick
Nick

Reputation: 356

VBA Excel Generate Unique Pages From Template and List

I have been working on this for sometime now (I am not experienced in VBA at all), but I keep getting errors so here we are.

Setup: For simplicity purposes I have two worksheets in a workbook. The first, "Daily Order", is a list of all my products, each row being a different product (approx. 1,000), each column indicating different information about the product (ie id, cost, weight, etc).
The second, "Template", is a pricing template that, when given product information, will generate a pricing table.

Objective: Create a VBA Macro to loop through each row of the "Daily Order" worksheet and for each row make a copy of the template sheet and append certain information to that new sheet.

What doesn't work:

Sub GeneratePriceBook()

Dim rw As Range

Dim temp As Worksheet
Dim ws As Worksheet
Dim daily As Worksheet

Set daily = Worksheets("Daily Order")
Set temp = Worksheets("Template")

temp.Activate

For Each rw In daily.Rows
    temp.Copy After:=Sheets(Sheets.Count)

    Set ws = Sheets(Sheets.Count)

    ws.Name = rw.Value

    With ws
        .Range("A6").Formula = "='Daily Order'!B" & rw.Row
        .Range("B6").Formula = "='Daily Order'!B" & rw.Row
        .Range("A3").Formula = "='Daily Order'!Q" & rw.Row
        .Range("E36").Formula = "='Daily Order'!M" & rw.Row
        .Range("E36").Formula = "='Daily Order'!Y" & rw.Row
        .Range("E37").Formula = "='Daily Order'!L" & rw.Row
    End With

Next rw

End Sub

Types of errors:

I have spent considerable time trying to isolate out certain areas that I think might be troublesome, but I keep ending up with either 424 errors or 1004 errors.

Again, I would greatly appreciate any help. Thank you!

Upvotes: 0

Views: 1114

Answers (1)

tigeravatar
tigeravatar

Reputation: 26640

I think this is what you're looking for:

Sub GeneratePriceBook()

    Dim wsDaily As Worksheet
    Dim wsTemp As Worksheet
    Dim lVisibility As XlSheetVisibility
    Dim strSheetName As String
    Dim rIndex As Long
    Dim i As Long

    Set wsDaily = Sheets("Daily Order")
    Set wsTemp = Sheets("Template")

    lVisibility = wsTemp.Visible          'In case template sheet is hidden
    wsTemp.Visible = xlSheetVisible

    For rIndex = 2 To wsDaily.Cells(Rows.Count, "A").End(xlUp).Row
        'Ensure valid sheet name
        strSheetName = wsDaily.Cells(rIndex, "A").Text
        For i = 1 To 7
            strSheetName = Replace(strSheetName, Mid(":\/?*[]", i, 1), " ")
        Next i
        strSheetName = Trim(Left(WorksheetFunction.Trim(strSheetName), 31))

        'Make sure the sheet name doesn't already exist
        If Not Evaluate("IsRef('" & strSheetName & "'!A1)") Then
            wsTemp.Copy After:=Sheets(Sheets.Count)
            With Sheets(Sheets.Count)
                .Name = strSheetName
                .Range("A6").Formula = "='" & wsDaily.Name & "'!B" & rIndex
                .Range("B6").Formula = "='" & wsDaily.Name & "'!B" & rIndex     'You are referencing the same cell as in A6?
                .Range("A3").Formula = "='" & wsDaily.Name & "'!Q" & rIndex
                .Range("E36").Formula = "='" & wsDaily.Name & "'!M" & rIndex
                .Range("E36").Formula = "='" & wsDaily.Name & "'!Y" & rIndex    'You are putting a second formula in E36?
                .Range("E37").Formula = "='" & wsDaily.Name & "'!L" & rIndex
            End With
        End If
    Next rIndex
    wsTemp.Visible = lVisibility  'Set template sheet to its original visible state

    Set wsDaily = Nothing
    Set wsTemp = Nothing

End Sub

Upvotes: 2

Related Questions