Need VBA to create new Workbook and name it based on cell value in original file

Hello.

I have two sheets attached for use as examples. I want to a macro in the "Sched_Example" file that will create a new workbook that looks exactly like the "Export Example" file (ignore formulas in that one), and then copy and past the info into the "Input" tab on the "Export_Example" file. I realize it's probably not ideal to create a macro that recreates "Export Example" each time but I'm not sure how to replicate this file most efficiently so that the data can be pulled into it.

Any help is appreciated.

Thanks for your quick reply...I'd like to create a new file each time and have the name of this file = to whatever is in cell A3 of the "Sched_Example" file.

I've created a template file that replicates most of what I need:

Dim strTemplate As String: strTemplate = "Path\template.xlsx"
Dim wb As Workbook

Set wb = Workbooks.Add(strTemplate)

This works perfectly but I am not sure how to then cut and land the data into the newly-created workbook. It also obvi doesn't change the file name as I described earlier.

Dim strTemplate As String: strTemplate = "C:\Users\havenc\Desktop\Upwork\Model_Template.xlsx"
Dim wb As Workbook

Set wb = Workbooks.Add(strTemplate)

Yes, they would be saved in the same folder.

Close...the new desired "Model Template" opens and cuts and pastes the data but with two issues:
1. It's pasting formulas rather than values from the "VDER-HAC" file (I realize the example I sent you didn't contain formulas so that's my bad).
2. The data that is being cut and pasted is found in tab "Detailed Outputs". The desired file name is on a tab called "User Inputs", so the source Work Sheets in the existing code are identical.

I'm not familiar with having two Source WSs...many thanks for your help thus far.


Sub CopyDataAndSave()
Application.ScreenUpdating = False
Dim desWB As Workbook, desWS As Worksheet, srcWS As Worksheet
Set srcWS = ThisWorkbook.Sheets("Detailed Outputs")
Set desWB = Workbooks.Open(Environ("userprofile") & "\Desktop\Upwork\Model_Template.xlsx")
Set desWS = Sheets("Input")
With srcWS
.Range("B8:M8").Copy desWS.Range("Q4")
.Range("B45:M45 ").Copy desWS.Range("Q8")
End With
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & Application.PathSeparator & srcWS.Range("C14").Value & ".xlsx", FileFormat:=51
Application.ScreenUpdating = True
End Sub

Awesome! It seems to work perfectly, many thanks again.

My one long term concern is giving access to these files to others for their use. I'm assuming a new user would need to alter the des path in order for it work. I would have the template tabs in the "VDER" file so they could be copied via the macro, but it is a protected file. Any thoughts on this? I guess a new user would need to save both files in the same folder and then change the des file path.

Well, there are only certain cells that you can manipulate/enter data into in the workbook, and you can't copy or move sheets.

The interesting thing is you can change the macros in the file.

I like your idea with the popup window and I think that would work.

...just have never created a popup.

Perfecto...thanks!

So, on this one...I use the code below (thanks again) to populate a file that I select called, "Model_Template" which I have attached. It works great.

That said, how could I change this code to append each update into the same file. In other words, ideally each time I run this macro the three tabs found in "Model_Template" duplicate and populate with the new information, appending to the end of the tab series while keeping the existing models/tabs.

Sub Calculate()

'Dim t1 As Double, t2 As Double
't1 = Timer
' Application.ScreenUpdating = False
Application.Calculate
' Application.ScreenUpdating = True
'
't2 = Timer
'msg = MsgBox("Done; " & Round(t2 - t1, 0) & " seconds elapsed.", vbOKOnly, "Goal Seek Complete")

Application.ScreenUpdating = False
Dim desWB As Workbook, desWS As Worksheet, srcWS1 As Worksheet, srcWS2 As Worksheet
Dim flder As FileDialog, FileName As String, FileChosen As Integer
Set srcWS1 = ThisWorkbook.Sheets("Detailed Outputs")
Set srcWS2 = ThisWorkbook.Sheets("User Inputs")
Set flder = Application.FileDialog(msoFileDialogFilePicker)
flder.Title = "Please Select a file."
flder.InitialFileName = Environ("userprofile") & "\Desktop\Upwork\"
FileChosen = flder.Show
FileName = flder.SelectedItems(1)
Set desWB = Workbooks.Open(FileName)
Set desWS = Sheets("Input")
With srcWS1
.Range("B8:M8").Copy
desWS.Range("Q4").PasteSpecial xlPasteValues
.Range("B45:M45 ").Copy
desWS.Range("Q5").PasteSpecial xlPasteValues
.Range("B28:M28").Copy
desWS.Range("Q8").PasteSpecial xlPasteValues
.Range("B75:M75").Copy
desWS.Range("Q9").PasteSpecial xlPasteValues


Application.CutCopyMode = False
End With
ActiveWorkbook.SaveAs FileName:=ActiveWorkbook.Path & Application.PathSeparator & srcWS2.Range("C14").Value & ".xlsx", FileFormat:=51
Application.ScreenUpdating = True

msg = MsgBox("Calculation complete. See Outputs tabs and Project Model for results.")

End Sub

It's too large to attach but here is a link:

https://drive.google.com/file/d/1D8S...ew?usp=sharing



The second module (at the end) contains the section of code in question.

Yep, it feeds the cash flow tab. So each time I make a new one, it appends it to the end of the existing tab series...I've had to reassess and decided that all the models for each project should exist in the same workbook (for now) bc the linking was getting way too hairy.

I meant that the Input tab feeds the Cash Flow tab (it's irrelevant, was just pointing it out). I do want to update the "Input" sheet using the code.

Thanks, that works great! Running the macro allows me select the "Model_Template" as its called for now where a new "Input" tab is added to the end of the file.

The attached is the result of me running it twice to test, hence the new "Input" tabs. That said, you'll notice the "Monthly Cash Flow" tab links to the first "Input" tab.

Is there a way that the "Monthly Cash Flow" tab could be duplicated as well to follow each new "Input" tab and then link to this new "Input" tab?

The structure never changes, so mechanically it's a matter of changing "Input!" in all the "Monthly Cash Flow" formulas to the name of the new Input tab (2, 3, etc.

If it's possible I can always change the name of each Input tab which would update the links. Basically, in a perfect world each "Input" tab would have its own "Monthly Cash Flow" tab.

No worries, I appreciate you taking the time to attempt.

Is it possible to at least create a new “Monthly Cash Flow” tab with the same values as the one in place (no updated links, just literally a copy of the last cash flow tab seen in the file)?

Thanks...the Monthly Cash Flow tabs all contain Index/Matches to an Input tab.

What does a formula look like where I have the sheet reference a cell value rather than a sheet name as you describe?

Perfect!

So I've altered the existing code to pull in more and/or different rows of data. It works well, but suddenly the problem I'm now having is just prior to the data populating I have to click through a series of named range warnings, even though I'm not pulling in any named ranges?

"The name 'xxxx' already exists. Click Yes to use that version of the name, or click No to rename the version of 'xxxx' you're moving or copying"

Here is the code:
Sub Calculate()
'Dim t1 As Double, t2 As Double
't1 = Timer
' Application.ScreenUpdating = False
Application.Calculate
' Application.ScreenUpdating = True
'
't2 = Timer
'msg = MsgBox("Done; " & Round(t2 - t1, 0) & " seconds elapsed.", vbOKOnly, "Goal Seek Complete")

Application.ScreenUpdating = False
Dim desWB As Workbook, desWS As Worksheet, srcWS1 As Worksheet
Dim flder As FileDialog, FileName As String, FileChosen As Integer
Set srcWS1 = ThisWorkbook.Sheets("Detailed Outputs")
Set flder = Application.FileDialog(msoFileDialogFilePicker)
flder.Title = "Please Select a file."
flder.InitialFileName = Environ("userprofile") & "\Desktop\"
FileChosen = flder.Show
FileName = flder.SelectedItems(1)
Set desWB = Workbooks.Open(FileName)
Sheets("Input").Copy after:=Sheets(Sheets.Count)
Set desWS = Sheets(Sheets.Count)
With srcWS1
.Range("B8:M8").Copy
desWS.Range("Q4").PasteSpecial xlPasteValues
.Range("B12:M12").Copy
desWS.Range("Q11").PasteSpecial xlPasteValues
.Range("B13:M13").Copy
desWS.Range("Q12").PasteSpecial xlPasteValues
.Range("B14:M14").Copy
desWS.Range("Q13").PasteSpecial xlPasteValues
.Range("B15:M15").Copy
desWS.Range("Q14").PasteSpecial xlPasteValues
.Range("B16:M16").Copy
desWS.Range("Q15").PasteSpecial xlPasteValues
.Range("B17:M17").Copy
desWS.Range("Q16").PasteSpecial xlPasteValues
.Range("B45:M45").Copy
desWS.Range("Q5").PasteSpecial xlPasteValues
.Range("B75:M75").Copy
desWS.Range("Q9").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
desWS.Columns.AutoFit
Sheets("Monthly Cash Flow").Copy after:=Sheets(Sheets.Count)
Application.ScreenUpdating = True
msg = MsgBox("Calculation complete. See Outputs tabs and Project Model for results.")
End Sub

No problem, the new VDER-HAC file is attached (via link) which feeds "SR_Portfolio" (also attached).




https://drive.google.com/file/d/1XSO...ew?usp=sharing

https://drive.google.com/file/d/1fea...ew?usp=sharing

That seems to work well as you'll see in the attached (link). Many thanks.

In the attached, what is the best way to sum each "Cash_Flow_xxxx" tab into the "Summary_Cash_Flow" tab while matching dates associated with each number?
I've considered some sort of "index/match" based on a list of tabs via a macro?
I've also considered modifying the "Aggregate" code you created a couple of weeks back that summed all tabs but not sure how to do so exactly.
New tabs would be added intermittently via the macro you created. I'd like to capture those as well.

https://drive.google.com/file/d/12DG...ew?usp=sharing

The link to my example is here: https://drive.google.com/file/d/1b5n...ew?usp=sharing

In this example you will see groupings of three tabs (grouped by color). In the "Summary_Cash_Flow" tab you will see that it is summing the cash flows found on each "Monthly_Cash_Flow" tab from each project.

New sets of tabs will be appended to this file as new projects are added to the portfolio. I would like a macro that sums (aggregates) data as it become available (new projects added) just as it shown being added together on the Summary Cash Flow tab.

The code you wrote to look through a folder and find similar data does this, but I am not sure how to alter this code to just work within a single workbook.

In the attached, the one macro in the file (view macros obvi) sums all the lines across any tab with a "*_CF" name into the orange "Summary_Cash_Flow" tab.

This works great, but while each of the *_CF tabs will have identical layouts and row names, the dates at the top will likely vary.

That said I would like the macro to match the proper date with the proper amount, realizing I likely have to expand the date range at the top of the Summary tab to accommodate this function.

To jog your memory (understood there's been so many iterations), the code below was used to crawl across files that were stored in a folder to perform a similar summation, the difference this time around is the tabs are all contained in one file and landing area is the same size as the source area.

So really the bold portion was the magic behind this one:

Sub updateTotals()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim wkbSource As Workbook, sPath As String
    Dim lCol As Long, desWs As Worksheet, srcWS As Worksheet, fDateCol As Long, x As Long, y As Long, strdate As String
    y = 4
    Set desWs = ThisWorkbook.Sheets("Summary")
    desWs.Range("D5:PW14").ClearContents
    'Const strPath As String = "C:\Project Models\"
    Const strPath As String = "C:\Forum Help\Yukon\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        Set srcWS = Sheets("Monthly Cash Flow")
        With srcWS
            .Range("B1").Formula = "=TEXT(LEFT(D2,FIND(""/"",TEXT(D2,""mm/dd/yyyy""),4)),""mm/dd/yy"")"
            strdate = .Range("B1")
            lCol = desWs.Cells(1, desWs.Columns.Count).End(xlToLeft).Column - 1
            fDateCol = desWs.Rows(2).Find(Format(.Range("B1").Value2, "m/dd/yy"), LookIn:=xlValues, lookat:=xlWhole).Column
            With desWs
                .Cells(5, fDateCol) = .Cells(5, fDateCol) + srcWS.Cells(5, 3) + srcWS.Cells(5, 4)
                .Cells(6, fDateCol) = .Cells(6, fDateCol) + srcWS.Cells(6, 3) + srcWS.Cells(6, 4)
                .Cells(7, fDateCol) = .Cells(7, fDateCol) + srcWS.Cells(7, 3) + srcWS.Cells(7, 4)
                .Cells(8, fDateCol) = .Cells(8, fDateCol) + srcWS.Cells(8, 3) + srcWS.Cells(8, 4)
                
                
            End With
            For x = fDateCol + 1 To lCol
                With desWs
                    On Error Resume Next
                    .Cells(5, x) = .Cells(5, x) + srcWS.Cells(5, y)
                    .Cells(6, x) = .Cells(6, x) + srcWS.Cells(6, y)
                    .Cells(7, x) = .Cells(7, x) + srcWS.Cells(7, y)
                    .Cells(8, x) = .Cells(8, x) + srcWS.Cells(8, y)
                    
                  
                    y = y + 1
                End With
            Next x
        End With
        y = 4
        wkbSource.Close False
        strExtension = Dir
    Loop
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

No, you aren't missing anything. That's a little oversight on my part that I didn't consider in the mockup.

If possible, Excel would (likely via this macro) grab the earliest date found in the "COD" column of every/any sheet and the formula to the right (=eomonth, 1) would calculate the remaining dates. Assuming that isn't possible, then change cell C2 of the ummary_Cash_Flow sheet to 1/1/18.

That's a good question, and yes, you are interpreting that correctly. That said, ideally the Summary tab in Cell C2 would retrieve the earliest "COD" date found in any of the tabs (ending in _CF) in cell C2.

Given that the date found in cell C2 in subsequent tabs will nearly always be greater than said date, I would like the value associated with it to land in the month it is associated.
As an (smaller) example I have provided an attached file. In said file, "Morristown" contains the earliest date found in cell C2 among "*_CF" tabs.
This then finds its way into C2 of the Summary tab. C2 and all subsequent cash flows in the other *_CF tabs obviously occur later than 10/1/19.
The dates that don't fall at the end of a month in these tabs would sum into the month with which they are associated in the summary tab, regardless of them occurring on the 1st.
In the Summary tab of the attached example you'll see that Aldrich and Richland don't become part of the summation until November and December respectively based on their start dates.

In the file posted yesterday at 10:24 AM, yes. I posted a smaller version in yesterday's 1:44 PM post for discussion's sake, but the concept applies regardless.

I see what you mean. I think in my rush (cutting and pasting) to make a mockup I created both issues that you point out.

Cell D2 in the Summary tab uses "=EOMONTH(C2,0)" where D2 in the Cash Flow tabs was "=EOMONTH(C2,1)". I fixed each tab (and the month issue in row 3) in the attached file.

So in this example (using the attached), "Morristown" is the earliest start date and ideally would begin the Summary tab on Row 2.

To your point, Aldrich as an example have values in both C2 and D2 that fall into the month of November. In a case like this I would want both columns to land in the November 2019 column of the Summary tab even though the column specifically states 11/30/19.
The ending month date is a catch-all for all values associated with said month/year in CF tabs.

One exception might be if there were more than one tab where both had identical begin dates in C2 and D2, ex. two files with C2=10/1/19 and D2=10/31/19. This is unlikely but I suppose not impossible.
In such an instance I'd want the values in each CF tab associated with 10/1/19 to aggregate under 10/1/2019 and those associated with 10/31/19 to fall under 10/31/19.

In short, any values in CF tabs occurring after the earliest project "C2 date" would fall into the ending month with which they are associated on the Summary tab, regardless of being tagged on the first or last day of a month.

No worries, I appreciate you taking the time. Sometimes I'm asking Excel to perform miracles that aren't always realistic.


That said, I've attached a simplified file that contains two important changes:

1. There is a "Start" and "End" tab. Each new CF tab would be placed between these tabs (manually by the user, no macro involved). With this in place cell C2 on the Summary tab will always choose the earliest date available across the CF tabs.

2. All dates are 1 month increments, all occurring at the end of a month. Values would sum across tabs based on EOM dates only.

Does this help?

I get an "object required" error. Performing debug highlights the portion in red/bold below:

Sub SumValues()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim Val As Range, ws As Worksheet, desWS As Worksheet, srcRng As Range, desRng As Range, i As Long, foundDate As Range
    Dim strdate As String, shStart As String, shEnd As String, lCol As Long
    Set desWS = Sheets("Summary_Cash_Flow")
    lCol = desWS.Cells(1, desWS.Columns.Count).End(xlToLeft).Column - 1
    Set desRng = Union(desWS.Range(desWS.Cells(5, 3), desWS.Cells(14, lCol)), desWS.Range(desWS.Cells(18, 3), desWS.Cells(22, lCol)), _
        desWS.Range(desWS.Cells(26, 3), desWS.Cells(31, lCol)), desWS.Range(desWS.Cells(35, 3), desWS.Cells(36, lCol)), _
        desWS.Range(desWS.Cells(40, 3), desWS.Cells(40, lCol)), desWS.Range(desWS.Cells(44, 3), desWS.Cells(47, lCol)))
    shStart = Sheets(2).Name
    shEnd = Sheets(Sheets.Count).Name
    With desWS
        .Range("C2").Formula = "=min('" & shStart & ":" & shEnd & "'!C2)"
        desRng.ClearContents
    End With
    For Each ws In Sheets
        If ws.Name Like "*_CF" Then
            lCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column - 1
            Set foundDate = desWS.Rows(2).Find(What:=Format(ws.Range("C2").Value2, "m/dd/yy"), LookIn:=xlValues, LookAt:=xlWhole)
            If Not foundDate Is Nothing Then
                Set srcRng = Union(ws.Range(ws.Cells(5, 3), ws.Cells(14, lCol)), ws.Range(ws.Cells(18, 3), ws.Cells(22, lCol)), _
                    ws.Range(ws.Cells(26, 3), ws.Cells(31, lCol)), ws.Range(ws.Cells(35, 3), ws.Cells(36, lCol)), _
                    ws.Range(ws.Cells(40, 3), ws.Cells(40, lCol)), ws.Range(ws.Cells(44, 3), ws.Cells(47, lCol)))
            End If
            For Each Val In srcRng
                desWS.Range(Val.Address).Offset(, foundDate.Column - 3).Value = desWS.Range(Val.Address).Offset(, foundDate.Column - 3).Value + Val.Value
            Next Val
        End If
    Next ws
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Yeah, I'm trying to lift and shift to another file. I changed the "deswb" based on the slightly different tab name, but still get an error near the bottom.

File is in the following link: https://drive.google.com/open?id=160...MHLBqHzp6DYGhF

Sorry for the delay....seems to work, thanks!