Running VBA on workbook B from VBA in workbook A

MrRodger

New Member
Joined
Dec 12, 2014
Messages
8
Hi All,

I am stuck on an intermediate level of VBA that I cant work out. I have a set of workbooks (Called Set B) that use some BeforeSave VBA to shrink themselves down to a more manageable size before they are saved. I have another workbook (Called Set A) that uses VBA to loop through all of Set B files refresh the data connections and then saves the Workbooks ideally to trigger the beforesave VBA in the original set A files before they are saved.

The problem is that when I save the files while using the looping macro from the set A file, the beforesave macro does not run in Set B workbooks. I tried also converting the BeforeSave macro to a regular sub and calling Application.Run or embedding the macro within set A to start but I cant get that to work either do to each workbook in the loop having a different name. Does anyone know how I can get these two macros to get along so that the one updates all the workbooks and each workbook that opens also shrinks before its saved?

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 'Lives in the Set B files


If Sheets("EngineTable").Range("A14") = "" Then 'If A14 is blank indicating already deleted values then just save

Else 'Otherwise if there are values beyond A15 indicating the table is not filtered by ACM then do the following code below

Worksheets("EngineTable").Range("H1").AutoFilter Field:=8, Criteria1:="<>" & ThisWorkbook.Worksheets("FLLookup").Range("E2") 'filter out our target ACM
Application.DisplayAlerts = False 'Do not display warnings
Worksheets("EngineTable").UsedRange.Offset(1, 0).Resize(Worksheets("EngineTable").UsedRange.Rows.Count - 1).Rows.Delete 'Selects all filtered values, offsets from the header column and deletes values removing data unrelated to given ACM
Application.DisplayAlerts = True 'Display Warnings
Worksheets("EngineTable").ListObjects("Table_FY15_Master_Focus_List_Engine_Final").Range. _
AutoFilter Field:=8 'clears filter to make things visible again
End If
End Sub


Sub AllFiles()
Dim folderPath As String
Dim filename As String
Dim wb As Workbook

folderPath = "C:\folder\path\here" 'change to suit

If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"

filename = Dir(folderPath & "*.xlsm")
Do While filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & filename)
wb.RefreshAll

'Call a subroutine here to operate on the just-opened workbook
Call Workbook_BeforeSave 'tried to save the files but the beforesave macro did not activate so I tried calling the macro manually here.

filename = Dir
Loop
Application.ScreenUpdating = True
End Sub
 

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Watch MrExcel Video

Forum statistics

Threads
1,122,780
Messages
5,598,038
Members
414,205
Latest member
Tushark

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
Top