Enhancing my current VBA

[ItalianPlatinum]

Hello - I have a very peculiar request. I currently run a process where the date to use is driven off the folder name (the date to run it for). I am looking for a way to remove the human element of someone typing in the day and including it somehow in my VBA or the use of a formula? see below for an example. Currently I need to modify the yellow shaded. in hindsight the worksheet that runs the code is in the folder anyways so could it just use that to drive the date to run other worksheets that reside in that same folder as well?

Book1
	A	B
1	Path	D:\ME\Documents\Files\House\Home\12.20.20\Monthly Credit Card breakdown.xlsx
2	Run Date PRE	Run Date Post
3	12/20/2020	12/20/2020
4
5
6
7
Sheet1

 

[davesexcel]

Where is the VBA you want enhanced?

 

[ItalianPlatinum]

Sub Pre()
Dim fromPath As String
Dim Cus$
Dim MyDate$
Dim Fd$
Dim For$
Dim wkb As Workbook, wkbFrom As Workbook
Dim rws As Long
Dim i As Long
Dim lr As Long
Dim StartTime As Double
Dim TimeTaken As String
   
StartTime = Timer

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

'   Check if WKB is open if open (close). if not continue
If WorkbookIsOpen(fromPath & "_ALL.xlsm") Then
Workbooks(fromPath & "_ALL.xlsm").Close SaveChanges:=True
End If

'   Check if WKB is open if open (close). if not continue
If WorkbookIsOpen(fromPath & "POST_ALL.xlsm") Then
Workbooks(fromPath & "POST_ALL.xlsm").Close SaveChanges:=True
End If

'   Get path from cell B1 on Main tab
fromPath = Sheets("MAIN").Range("B1")

'   Make sure there is a backslash at the end of the from path
If Right(fromPath, 1) <> "\" Then fromPath = fromPath & "\"

Set wkb = ThisWorkbook
Set wkbFrom = Workbooks.Open(fromPath & "_ALL.xlsm")

'  Clearing all data compare & Main tab
Workbooks("COMPARSION").Sheets("MAIN").Range("J6:K8").ClearContents
Workbooks("COMPARSION").Sheets("COMPARE").Range("B2:BE43").ClearContents

'  Deleting all data, prep/post /files data and saving
With Sheets("Post Rel")
   .Range("A2:AP" & .Range("A" & rows.count).End(xlDown).Row).Delete
End With

With Sheets("T PRE")
   .Range("A2:X" & .Range("A" & rows.count).End(xlDown).Row).Delete
End With

With Sheets("T Post")
   .Range("A2:X" & .Range("A" & rows.count).End(xlDown).Row).Delete
End With

 

[ItalianPlatinum]

let me simplify the ask

Sub Pre()
Dim fromPath As String
Dim Cus$
Dim MyDate$
Dim Fd$
Dim For$
Dim wkb As Workbook, wkbFrom As Workbook
Dim rws As Long
Dim i As Long
Dim lr As Long
Dim StartTime As Double
Dim TimeTaken As String
  
StartTime = Timer

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

'   Check if WKB is open if open (close). if not continue
If WorkbookIsOpen(fromPath & "_ALL.xlsm") Then
Workbooks(fromPath & "_ALL.xlsm").Close SaveChanges:=True
End If

'   Check if WKB is open if open (close). if not continue
If WorkbookIsOpen(fromPath & "POST_ALL.xlsm") Then
Workbooks(fromPath & "POST_ALL.xlsm").Close SaveChanges:=True
End If

'   Get path from cell B1 on Main tab
fromPath = Sheets("MAIN").Range("B1")

'   Make sure there is a backslash at the end of the from path
If Right(fromPath, 1) <> "\" Then fromPath = fromPath & "\"

Set wkb = ThisWorkbook
Set wkbFrom = Workbooks.Open(fromPath & "_ALL.xlsm")

'  Clearing all data compare & Main tab
Workbooks("COMPARSION").Sheets("MAIN").Range("J6:K8").ClearContents
Workbooks("COMPARSION").Sheets("COMPARE").Range("B2:BE43").ClearContents

'  Deleting all data, prep/post /files data and saving
With Sheets("Post Rel")
   .Range("A2:AP" & .Range("A" & rows.count).End(xlDown).Row).Delete
End With

With Sheets("T PRE")
   .Range("A2:X" & .Range("A" & rows.count).End(xlDown).Row).Delete
End With

With Sheets("T Post")
   .Range("A2:X" & .Range("A" & rows.count).End(xlDown).Row).Delete
End With

Let me simplify the ask. the issue i have seen is at times someone may forget to modify B1 and that overrides prior data (prior folders). So if there is a way for the files to run in the folder where the VBA is. The folder will have 3 integral files

1. VBA code worksheet
2. Worksheet that runs data and copies to a new sheet
3. Worksheet that runs data

 

[davesexcel]

You have the complete workbook name in B1, then your code is determining if B1 has a "\" at the end. Then you are adding another workbook name at the end of that to open.

 

[ItalianPlatinum]

You have the complete workbook name in B1, then your code is determining if B1 has a "\" at the end. Then you are adding another workbook name at the end of that to open.

That is a typo when mocking up a draft to remove confidential data. it is just the folder path you are correct