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

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
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

J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
168
shknbk2
S
N
  • Question
VBA Questions - Copying dynamic data from one tab to another and deleting filtered rows
Replies
1
Views
188
DanteAmor
DanteAmor
S
  • Solved
VBA does not continue to copy after blank cell
Replies
8
Views
526
jolivanes
jolivanes
G
  • Question
How can i extract the correct leave time on this code?
Replies
1
Views
364
rlv01
R
S
  • Question
Text file creation macro
Replies
5
Views
266
rlv01
R

Forum statistics

Threads
1,215,069
Messages
6,122,956
Members
449,096
Latest member
Anshu121

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