VBA- Refer to a File by name & Today's date dynamically

T

TheHack22

Board Regular
Joined
Feb 3, 2021
Messages
121
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
Hi Excel VBA Experts,

I have a few Subs that does what it's supposed to - it takes an Excel Template, makes a copy and populates it with data from multiple Tabs.
My objective is to make a copy of the Template ("Master Data Roll Up - Template.xlsx") to "Master Data Roll Up - Template 02.11.2022.xlsx.(by adding today's date).
I declared a global variable((WBkNameRollUp).

How do I make a copy of the template and add today's date to the new file name? Then, refer to the new file as "Template Name" + "Today's date"?
I'm not a VBA programmer . I would usually adapt VBA codes to suit my needs. Can someone please assist me with this?

Option Explicit
Dim WBkName As String
'Const WBkName As String = "Master Data Calculator.xlsm"
Const WBkNameRollUp As String = "Master Data Roll Up - Template.xlsx"
Sub SaveToRelativePath()
Dim relativePath As String

Workbooks.Open ("C:\PowerBI Hardrive\Master Data Roll Up - Template.xlsx")
relativePath = ThisWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
ActiveWorkbook.SaveAs filename:=relativePath
End Sub
Sub PIT_1_USA()

Windows(ThisWorkbook.Name).Activate
Sheets("PIT 1 - US").Activate

Range("A2").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

Application.WindowState = xlNormal

Windows(WBkNameRollUp).Activate
Worksheets("Data").Range("A2").PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

End Sub
Sub PIT_2_USA()
Windows(ThisWorkbook.Name).Activate
Sheets("PIT 2 - US").Activate

Range("A2").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

Windows(WBkNameRollUp).Activate
Worksheets("Data").Activate
Range("A1").Select
Range("A1").End(xlDown).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(ThisWorkbook.Name).Activate

End Sub
Sub PIT_3_USA()
Windows(ThisWorkbook.Name).Activate
Sheets("PIT 3 - US").Activate

Range("A2").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

Windows(WBkNameRollUp).Activate
Worksheets("Data").Activate
Range("A1").Select
Range("A1").End(xlDown).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(ThisWorkbook.Name).Activate


End Sub
Sub PIT_4_USA()
Windows(ThisWorkbook.Name).Activate
Sheets("PIT 4 - US").Activate

Range("A2").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

Windows(WBkNameRollUp).Activate
Worksheets("Data").Activate
Range("A1").Select
Range("A1").End(xlDown).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(ThisWorkbook.Name).Activate


End Sub
Sub PIT_6_USA()
Windows(ThisWorkbook.Name).Activate
Sheets("PIT 6 - US").Activate

Range("A2").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

Windows(WBkNameRollUp).Activate
Worksheets("Data").Activate
Range("A1").Select
Range("A1").End(xlDown).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(ThisWorkbook.Name).Activate


End Sub
Sub PIT_1_INTL()
Windows(ThisWorkbook.Name).Activate
Sheets("PIT 1 - INTL").Activate

Range("A2").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

Windows(WBkNameRollUp).Activate
Worksheets("Data").Activate
Range("A1").Select
Range("A1").End(xlDown).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(ThisWorkbook.Name).Activate


End Sub
Sub PIT_2_INTL()
Windows(ThisWorkbook.Name).Activate
Sheets("PIT 2 - INTL").Activate

Range("A2").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

Windows(WBkNameRollUp).Activate
Worksheets("Data").Activate
Range("A1").Select
Range("A1").End(xlDown).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(ThisWorkbook.Name).Activate


End Sub
Sub PIT_3_INTL()
Windows(ThisWorkbook.Name).Activate
Sheets("PIT 3 - INTL").Activate

Range("A2").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

Windows(WBkNameRollUp).Activate
Worksheets("Data").Activate
Range("A1").Select
Range("A1").End(xlDown).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(ThisWorkbook.Name).Activate


End Sub
Sub PIT_4_INTL()
Windows(ThisWorkbook.Name).Activate
Sheets("PIT 4 - INTL").Activate

Range("A2").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

Windows(WBkNameRollUp).Activate
Worksheets("Data").Activate
Range("A1").Select
Range("A1").End(xlDown).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(ThisWorkbook.Name).Activate


End Sub
Sub PIT_6_INTL()
Windows(ThisWorkbook.Name).Activate
Sheets("PIT 6 - INTL").Activate

Range("A2").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

Windows(WBkNameRollUp).Activate
Worksheets("Data").Activate
Range("A1").Select
Range("A1").End(xlDown).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(ThisWorkbook.Name).Activate

End Sub

Sub CopyFormulaDown()
Dim LastPopulatedRow As Long
Windows(WBkNameRollUp).Activate
'Find last populated row
LastPopulatedRow = Range("S" & Rows.Count).End(xlUp).Row
'Select the rows where formula is to be populated
Range("U2: " & "V" & LastPopulatedRow).FillDown
Windows(WBkNameRollUp).Activate
Sheets("PVT").Activate
ActiveWorkbook.RefreshAll
ActiveWindow.WindowState = xlMaximized
Range("F4").Font.Bold = True
Range("F4").Interior.ColorIndex = 28
ActiveWindow.Zoom = 100
End Sub

Sub ColorNAs()
Sheets("Data").Activate
On Error Resume Next
ActiveSheet.UsedRange.SpecialCells(xlConstants, xlErrors).Interior.Color = 255
On Error GoTo 0
End Sub

Sub cMasterALLRollUpCopyNPaste()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

Call SaveToRelativePath
Call PIT_1_USA
Call PIT_1_USA
Call PIT_2_USA
Call PIT_3_USA
Call PIT_4_USA
Call PIT_6_USA
Call PIT_1_INTL
Call PIT_2_INTL
Call PIT_3_INTL
Call PIT_4_INTL
Call PIT_6_INTL
Call CopyFormulaDown
Call ColorNAs

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
MsgBox "10 PITs data copied to Master Roll-Up Template" & vbCrLf & _
"All PVT Refreshed"
End Sub
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
does this help??
VBA Code: 
Sub tst()
Const WBkNameRollUp As String = "Master Data Roll Up - Template "
tt = WBkNameRollUp & Format(Date, "dd.mm.yyyy") & ".xlsx"
MsgBox tt

End Sub
 
Upvote 0
offthelip said:
does this help??
VBA Code: 
Sub tst()
Const WBkNameRollUp As String = "Master Data Roll Up - Template "
tt = WBkNameRollUp & Format(Date, "dd.mm.yyyy") & ".xlsx"
MsgBox tt

End Sub
Click to expand...
@offthelip

Thanks very much. I'll test this at work on Monday and provide some feedback.
At a glance, this looks exactly like what I envisioned, but doesn't have the skillset to come up with.

Imran
 
Upvote 0
@Imran_IsshackNY stick with @offthelip for the answer to your question but I couldn't resist suggesting you streamline your code a bit since most of your modules are copies of the same thing.
I can't follow your selecting of the copy area without seeing your worksheets but consider changing your main module "cMasterALLRollUpCopyNPaste" to this:
(using a loop)

VBA Code: 
Sub cMasterALLRollUpCopyNPaste()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    
    Call SaveToRelativePath
    
    Dim sht As Worksheet
    For Each sht In ThisWorkbook.Worksheets
        If Left(sht.Name, 3) = "PIT" Then                 ' Select any sheet starting with the PIT in the name
            Call Copy_PIT(shtName:=sht.Name)
        End If   
    Next sht
    Call CopyFormulaDown
    Call ColorNAs
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    MsgBox "10 PITs data copied to Master Roll-Up Template" & vbCrLf & _
    "All PVT Refreshed"
End Sub

And then replace all your "PIT_" subs with this:-

VBA Code: 
Sub Copy_PIT(shtName As String)             ' Changed this passing name from MAIN sub loop
    
    Windows(ThisWorkbook.Name).Activate
    Sheets(shtName).Activate                     ' Changed this passing name from MAIN sub loop
    
    Range("A2").Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    
    Windows(WBkNameRollUp).Activate
    Worksheets("Data").Activate
    Range("A1").Select
    Range("A1").End(xlDown).Offset(1, 0).Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Windows(ThisWorkbook.Name).Activate

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
macro for copying values to the next blank cell
Replies
5
Views
415
Micron
M
C
  • Question Question
How to automatically paste the data from one sheet to another using VBA
Replies
4
Views
235
Alex Blakenburg
A
D
  • Solved
VBA If statement to continue
2
Replies
17
Views
604
dinunan
D
S
  • Question Question
Dynamic Address by VBA
Replies
8
Views
152
MikeVol
MikeVol
willow1985
  • Solved
VBA Run-time error 91 - Object variable or With block variable not set when trying to refresh data/Sleep
Replies
4
Views
280
willow1985
willow1985

Forum statistics

Threads
1,223,908
Messages
6,175,307
Members
452,633
Latest member
DougMo

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top