Insert diffirent values in auto-generated templates

[Chrusse]

Hi guys,

I've been asked to make several thousand invoices, so i thought i'd use VBA to generate them for me to save me ALOT of time. Each invoice look the same, but has to have a unique name and contain a unique vendornumber in cell B3.

I have 2 column (A and B). A is the name of the excel file i want to make, B is the unique vendornumber i want to be placed in B3 on all of the files i make. Everyone file has to be based on the same template. There are hundreds unique of ID's in each column.

So if a row in my table looks like this:
A2 has the value NAME1.
B2 has the value 9999

Then i'd like to create an excel file (based on my template) called NAME1, that contains 9999 in the B3 cell.

So far i've been able to generate as many excel files as i list in column A with the correct name and correct template. But i can't figure out how i get a unique vendornumber in the B3 cell in each file.

This is my code so far:

Public Sub SaveTemplate()

  Const strSavePath As String = "C:\Users\Desktop\Invoice testing\"
  Const strTemplatePath As String = "C:\Users\Desktop\Invoice testing\Template\Invoice Template without VAT1.xlsx"


  Dim rngNames As Excel.Range
  Dim rng As Excel.Range
  Dim wkbTemplate As Excel.Workbook
  
  Set rngNames = ThisWorkbook.Worksheets("Sheet1").Range("A2:A200").Cells
  
  Set wkbTemplate = Application.Workbooks.Open(strTemplatePath)
  
  For Each rng In rngNames.Cells
    wkbTemplate.SaveAs strSavePath & rng.Value
    
    Set wkbTemplate = ActiveWorkbook
    wkbTemplate.Save
    
        
  Next rng
  
  wkbTemplate.Close SaveChanges:=False
  
End Sub

I really hope you guys can help me, i'm stuck. Yet i have a feeling the answer might be simple.

What should i add to make this work?

 

[Chrusse]

I dont know if this helps, but my columns look like this:

FILENAME	Vendornumber
FileName_01	111
FileName_02	222
FileName_03	333
FileName_04	444
FileName_05	555
FileName_06	666
FileName_07	777
FileName_08	888

<colgroup><col><col></colgroup><tbody>
</tbody>

So i need it go generate a copy of a template i already have, with the filename listed in column A, and each the vendornumbers should match. So if i were to open FileName01 i'd find the vendornumber 111 in the B3 Cell of that file.

 

[Chrusse]

I solved it myself after hours of looking on the web.

In case anyone else ever run into the same challenge, here is the code i found:

[COLOR=#5F6A72][FONT=courier new]Option Explicit[/FONT][/COLOR]

[COLOR=#5F6A72][FONT=courier new]Sub FillOutTemplate()[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]'Jerry Beaucaire  4/25/2010[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]'From Sheet1 data fill out template on sheet2 and save[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]'each sheet as its own file.[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]Dim LastRw As Long, Rw As Long, Cnt As Long[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]Dim dSht As Worksheet, tSht As Worksheet[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]Dim MakeBooks As Boolean, SavePath As String[/FONT][/COLOR]

[COLOR=#5F6A72][FONT=courier new]Application.ScreenUpdating = False  'speed up macro execution[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]Application.DisplayAlerts = False   'no alerts, default answers used[/FONT][/COLOR]

[COLOR=#5F6A72][FONT=courier new]Set dSht = Sheets("[/FONT][/COLOR][COLOR=#CC0000][FONT=courier new]Data[/FONT][/COLOR][COLOR=#5F6A72][FONT=courier new]")           'sheet with data on it starting in row2[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]Set tSht = Sheets("[/FONT][/COLOR][COLOR=#CC0000][FONT=courier new]Template[/FONT][/COLOR][COLOR=#5F6A72][FONT=courier new]")       'sheet to copy and fill out[/FONT][/COLOR]

[COLOR=#5F6A72][FONT=courier new]'Option to create separate workbooks[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]    MakeBooks = MsgBox("Create separate workbooks?" & vbLf & vbLf & _[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]        "YES = template will be copied to separate workbooks." & vbLf & _[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]        "NO = template will be copied to sheets within this same workbook", _[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]            vbYesNo + vbQuestion) = vbYes[/FONT][/COLOR]

[COLOR=#5F6A72][FONT=courier new]If MakeBooks Then   'select a folder for the new workbooks[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]    MsgBox "Please select a destination for the new workbooks"[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]    Do[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]        With Application.FileDialog(msoFileDialogFolderPicker)[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]            .AllowMultiSelect = False[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]            .Show[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]            If .SelectedItems.Count > 0 Then    'a folder was chosen[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]                SavePath = .SelectedItems(1) & "\"[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]                Exit Do[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]            Else                                'a folder was not chosen[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]                If MsgBox("Do you wish to abort?", _[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]                    vbYesNo + vbQuestion) = vbYes Then Exit Sub[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]            End If[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]        End With[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]    Loop[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]End If[/FONT][/COLOR]

[COLOR=#5F6A72][FONT=courier new]'Determine last row of data then loop through the rows one at a time[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]    LastRw = dSht.Range("A" & Rows.Count).End(xlUp).Row[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]    [/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]    For Rw = 2 To LastRw[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]        tSht.Copy After:=Worksheets(Worksheets.Count)   'copy the template[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]        With ActiveSheet                                'fill out the form[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]            'edit these rows to fill out your form, add more as needed[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]            [/FONT][/COLOR][COLOR=#CC0000][FONT=courier new].Name = dSht.Range("A" & Rw)[/FONT][/COLOR]
[COLOR=#CC0000][FONT=courier new]            .Range("B3").Value = dSht.Range("A" & Rw).Value[/FONT][/COLOR]
[COLOR=#CC0000][FONT=courier new]            .Range("C4").Value = dSht.Range("B" & Rw).Value[/FONT][/COLOR]
[COLOR=#CC0000][FONT=courier new]            .Range("D5:D7").Value = dSht.Range("C" & Rw, "E" & Rw).Value[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]        End With[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]        [/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]        If MakeBooks Then       'if making separate workbooks from filled out form[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]            ActiveSheet.Move[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]            ActiveWorkbook.SaveAs SavePath & [/FONT][/COLOR][COLOR=#CC0000][FONT=courier new]Range("B3").Value[/FONT][/COLOR][COLOR=#5F6A72][FONT=courier new], xlNormal[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]            ActiveWorkbook.Close False[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]        End If[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]        Cnt = Cnt + 1[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]    Next Rw[/FONT][/COLOR]

[COLOR=#5F6A72][FONT=courier new]    dSht.Activate[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]    If MakeBooks Then[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]        MsgBox "Workbooks created: " & Cnt[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]    Else[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]        MsgBox "Worksheets created: " & Cnt[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]    End If[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]    [/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]Application.ScreenUpdating = True[/FONT][/COLOR]
[COLOR=#5F6A72][FONT=courier new]End Sub[/FONT][/COLOR]