Create new workbooks from template based on sheet with data

Jelmer · #1 03-07-2019, 08:39 AM

I have been searching the web and I found several answers in the right direction but since I'm not a master in VBA I was not able to figure it out.
I have an Excel sheet with data which is an export of a library in SharePoint. I need to be able to filter this data and make changes where required and then use the visible data to create new workbooks based on a template called 'CRS Template' and save them as .xlsx. This needs to be done for each visible row with data.
My idea is to have a workbook called 'CRS Data Input' with on sheet 'Create CRSs' a button to activate the VBA code so I can make the required changes in the second sheet (let's call it 'Data') where I will copy and paste the data from the export from SharePoint.
Then, what the code needs to do for each row is as follows:

create new workbook from 'CRS Template'
copy data from column B in 'Data' to cell K1 in this new workbook (this is a hyperlink to a file in SharePoint and should still work)
copy data from column F in 'Data' to cell N1 in this new workbook
copy data from column E in 'Data' to cell K2 in this new workbook
copy data from column I in 'Data' to cell K3 in this new workbook
save the new workbook as .xlsx with as filename the value in cell K1 with '-CRS' attached to it. So if K1 has 'test' in it, the filename with extension would be test-CRS.xlsx. I would like to save these workbooks in a folder 1 level below the folder in which the 'CRS Data Input' is stored (so using ThisWorkbook.Path & ..\ I guess?)

I think what I want is possible but I just can't figure it out how to do it exactly...

Any help would be very much appreciated!

Jelmer · #2 03-08-2019, 02:21 AM

I now have the below and it is working, however, it does not recognize the visible rows correctly and it does not stop automatically (it will stop because there is already a file called '-CRS.xlsx' in the output folder. What am I doing wrong?

Code:

 
Sub Create_Workbook_From_Template_and_Save()
Dim rng As Range
Dim x As Integer
Set rng = Workbooks("CRS Data Input").Worksheets("Data").ListObjects("Table_query").Range.SpecialCells(xlCellTypeVisible)

x = 0

For x = 0 To rng.Rows.Count
Dim Flname As String
Dim Rev As String
Dim Title As String
Dim Subcontractor As String
Flname = "B" & (2 + x)
Rev = "F" & (2 + x)
Title = "E" & (2 + x)
Subcontractor = "I" & (2 + x)

'Open new workbook from template
Workbooks.Open FileName:=ThisWorkbook.Path & "\CRS Template.xlsx", Editable:=False
'Copy data from data sheet to template

Workbooks("CRS Data Input").Worksheets("Data").Range(Flname).Copy Destination:=Workbooks("CRS Template").Worksheets("CRS").Range("K1")
Workbooks("CRS Data Input").Worksheets("Data").Range(Rev).Copy Destination:=Workbooks("CRS Template").Worksheets("CRS").Range("N1")
Workbooks("CRS Data Input").Worksheets("Data").Range(Title).Copy Destination:=Workbooks("CRS Template").Worksheets("CRS").Range("K2")
Workbooks("CRS Data Input").Worksheets("Data").Range(Subcontractor).Copy Destination:=Workbooks("CRS Template").Worksheets("CRS").Range("K3")
'Save template in Output folder with custom filename
Dim FileName As String
FileName1 = Range("K1").Text
Workbooks("CRS Template").Close SaveChanges:=True, FileName:=ThisWorkbook.Path & "\Output\" & FileName1 & "-CRS.xlsx"
Next x
End Sub

Pecoflyer · #3 03-08-2019, 04:40 AM

Hi
please do not quote entire posts unnecessarily. They are just clutter and make the threads hard to follow.
Thanks

NoSparks · #4 03-08-2019, 09:38 AM

I think you could get the data directly from the table

Code:

Sub Create_Workbook_From_Template_and_Save()

    Dim rng As Range, cel As Range
    Dim Flname As String
    Dim Rev As String
    Dim Title As String
    Dim Subcontractor As String

Set rng = Workbooks("CRS Data Input").Worksheets("Data").ListObjects("Table_query").ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible)

For Each cel In rng
    Flname = cel.Value
    Rev = cel.Offset(, 4).Value
    Title = cel.Offset(, 3).Value
    Subcontractor = cel.Offset(, 7).Value

    'Open new workbook from template
    Workbooks.Open FileName:=ThisWorkbook.Path & "\CRS Template.xlsx", Editable:=False
    
    'Copy data from data sheet to template
    Workbooks("CRS Template").Worksheets("CRS").Range("K1") = Flname
    Workbooks("CRS Template").Worksheets("CRS").Range("N1") = Rev
    Workbooks("CRS Template").Worksheets("CRS").Range("K2") = Title
    Workbooks("CRS Template").Worksheets("CRS").Range("K3") = Subcontractor
    
    'Save template in Output folder with custom filename
    Workbooks("CRS Template").Close SaveChanges:=True, FileName:=ThisWorkbook.Path & "\Output\" & Flname & "-CRS.xlsx"
Next cel

End Sub

a couple of links for more insight into tables:
https://www.thespreadsheetguru.com/b...t-excel-tables
https://www.jkp-ads.com/Articles/Excel2007TablesVBA.asp

Jelmer · #5 03-12-2019, 02:14 AM

Thank you very much, NoSparks! Now it stops when it's out of visible rows

However, the data for Flname is a hyperlink in the Data sheet and should also be a hyperlink when the template is saved as new workbook. Is this possible?

I tried

Code:

Dim Flname As Hyperlink

but that didn't work, unfortunately.

EDIT:
To be more clear, the hyperlink shows as 1234-5678 but links to for example google.com/1234-5678. The cell in the template should still read 1234-5678 but the link should be still the same. This is important as the filename is based on the contents of this cell.

NoSparks · #6 03-12-2019, 08:25 AM

Maybe this

Code:

Sub Create_Workbook_From_Template_and_Save()

    Dim rng As Range, cel As Range
    Dim Flname As String
    Dim FlLink As String
    Dim Rev As String
    Dim Title As String
    Dim Subcontractor As String

Set rng = Workbooks("CRS Data Input").Worksheets("Data").ListObjects("Table_query").ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible)

For Each cel In rng
    Flname = cel.Value
    FlLink = cel.Hyperlinks(1).Address
    Rev = cel.Offset(, 4).Value
    Title = cel.Offset(, 3).Value
    Subcontractor = cel.Offset(, 7).Value

    'Open new workbook from template
    Workbooks.Open FileName:=ThisWorkbook.Path & "\CRS Template.xlsx", Editable:=False
    
    'Copy data from data sheet to template
    Workbooks("CRS Template").Worksheets("CRS").Range("K1").Hyperlinks.Add Anchor:=Range("K1"), Address:=FlLink, TextToDisplay:=Flname
    Workbooks("CRS Template").Worksheets("CRS").Range("N1") = Rev
    Workbooks("CRS Template").Worksheets("CRS").Range("K2") = Title
    Workbooks("CRS Template").Worksheets("CRS").Range("K3") = Subcontractor
    
    'Save template in Output folder with custom filename
    Workbooks("CRS Template").Close SaveChanges:=True, FileName:=ThisWorkbook.Path & "\Output\" & Flname & "-CRS.xlsx"
Next cel

End Sub

Jelmer · #7 03-12-2019, 12:18 PM

That did the trick! Thank you so much!

I had been playing around with .Hyperlinks.Add but I couldn't figure it out. Sometimes all you just need a pair of fresh eyes!

Thread Tools
Show Printable Version Email this Page
Display Modes
Switch to Linear Mode Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Copy data from one sheet to another based on a certain criteria	shina67	Excel Programming	2	12-28-2016 07:32 AM
Mailmerge create a coloured box based on data	haydencohen	Mail Merge	1	11-25-2015 03:32 PM
Create custom quote based on template	torma156	Word	3	09-06-2015 11:04 AM
Create a Bar with a slider that move based on data	jgallet	Excel	8	08-21-2015 03:41 PM
How to create a data validation based on another cell's value??	cfreezy	Excel	1	06-18-2015 09:51 AM