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!

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