I have written macro which saves current workbook after every ten second,
Option Explicit
Public ONTIMER_S As Date
Public Sub SaveBook()
ThisWorkbook.Save
ONTIMER_S = Now() + TimeValue("00:00:10")
Application.OnTime ONTIMER_S, "SaveBook"
End Sub
this works fine for one workbook, I want to run this macro on multiple workbooks, when I try to add this macro to any other workbook I get error " ambigous name detected Savebook "
Is there any way to run this macro on multiple workbooks at same time, either by writing this macro to each workbook, or somehow running this macro on multiple workbooks
You can set n workbooks in one main code in one main workbook like below
Option Explicit
Public ONTIMER_S As Date
Public Sub SaveBook()
dim wb1 as workbook, wb2 as workbook
dim name1 as string, name2 as string
name1 ="name1"
name2 = "name2"
if IsWorkBookOpen(name1 )=true then
set wb1= wborkbooks(name1 )
wb1.save
end if
if IsWorkBookOpen(name2 )=true then
set wb2= wborkbooks(name2 )
wb2.save
end if
set wb1 =nothing
set wb2 = nothing
ONTIMER_S = Now() + TimeValue("00:00:10")
Application.OnTime ONTIMER_S, "SaveBook"
End Sub
function to check is wb open
Function IsWorkBookOpen(Name As String) As Boolean
Dim xWb As Workbook
On Error Resume Next
Set xWb = Application.Workbooks.Item(Name)
IsWorkBookOpen = (Not xWb Is Nothing)
End Function
Related
I put together a sub that allows you to input the name of the file you want your sub to refer to instead of encoding a single file. However beyond the input box, I get the error "subscript out of range". I tried entering the file name with and without "" and file extension .xls
Sub tester()
Dim wbName As String
wbName = Application.InputBox("What is the workbook name?")
If Right(wbName, 4) <> ".xls" Then wbName = wbName + ".xls"
Set mainWB = Workbooks(wbName)
Dim copyThis As Range, pasteThis As Range
Set copyThis = mainWB.Worksheets(2).Columns("F")
Set pasteThis = Workbooks("VBA Workbook.xlsm").Worksheeets(1).Columns("A")
copyThis.Copy Destination:=pasteThis
End Sub
Whenever there is user intervention, you will have to use lot of error handling to avoid possible errors. I recommned using a Userform insetad. Instead of the making a user, type the workbook name, use a UserForm witm a ComboBox1 (As shown in the image below) populated with the names of all open workbooks so that user can choose the relevant workbook rather than typing the name
Code
Option Explicit
Private Sub UserForm_Initialize()
Dim wkb As Workbook
Me.Label1.Caption = "Please select the relevant workbook"
With Me.ComboBox1
'~~> Loop thorugh all open workbooks and add
'~~> their name to the Combobox
For Each wkb In Application.Workbooks
.AddItem wkb.Name
Next wkb
End With
End Sub
Private Sub CommandButton1_Click()
If ComboBox1.ListIndex = -1 Then
MsgBox "Please select a wotkbook name and try again"
Exit Sub
End If
Dim wb As Workbook
Set wb = Workbooks(ComboBox1.List(ComboBox1.ListIndex))
With wb
MsgBox .FullName
'~~> Do what you want
End With
End Sub
I have two workbooks, "Test1" and "Test2" each with a sheet inside. The code is inside the "Test1" workbook, inside the "ThisWorkbook" module.
I have a Vlookup in the sheet "Mytest1" inside the "Test1" workbook, that simply does a Vlookup with workbook "Test2" inside sheet "Mytest2". Both workbooks are password protected, I am having an issue where if I have the workbook "Test2" opened on another computer, I get a prompt to "Enter Password" for "Test2" when I open my "Test1" workbook. I need to have the Vlookups autoupdate without any prompts for password entries or the second workbook opening up.
I have posted screenshots below of both workbooks and code, alongside the code itself. Please edit or ask me any questions to clarify anything.
Private Sub Workbook_Open()
Workbooks.Open Filename:="\\FILEPATH\Databases\Test 2.xlsm", Password:="Swarf", Updatelinks:=3
ActiveWorkbook.Close SaveChanges:=True
End Sub
I dont have time to test, but will later. I'd try rewriting VLOOKUP as a wrapper round VLOOKUP like so
Function VLOOKUP_BYPASS(LookFor As Variant, Rng As Excel.Range, lngCol As Long) As Variant
Dim strWorkbook As String
strWorkbook = Rng.Parent.Parent.Name
If WORKBOOKOPEN(strWorkbook) Then
VLOOKUP_BYPASS = Application.WorksheetFunction.VLookup(LookFor, Rng, lngCol, False)
Else
VLOOKUP_BYPASS = "NA"
End If
End Function
Function WORKBOOKOPEN(strWorkbookName As String) As Boolean
WORKBOOKOPEN = False
Dim wb As Excel.Workbook
On Error GoTo eHandle
Set wb = Workbooks(strWorkbookName)
WORKBOOKOPEN = True
Exit Function
eHandle:
End Function
This is the solution I came up with, I simply made the file I am using to reference my Vlookup ("Test 2" Workbook) open up as a read-only file!
Private Sub Workbook_Open()
Workbooks.Open Filename:="\\FILEPATH \Databases\Test 2.xlsm", Password:="Swarf", Updatelinks:=3,ReadOnly:=True
ActiveWorkbook.Close SaveChanges:=False
End Sub
I have master sheet in which data from various "options" sheets pulled now I want to refresh all "options" sheets to get refresh on specific interval for that I have following vba code in master sheet
Public interval As Double
Sub Dosomething()
Dim xSh As Worksheet
Application.ScreenUpdating = False
For Each xSh In Worksheets
xSh.Select
Call macro_timer
Next
Application.ScreenUpdating = True
End Sub
Sub macro_timer()
interval = Now + TimeValue("00:03:00")
Application.OnTime interval, "my_macro"
End Sub
Sub my_macro()
For Each wb In Application.Workbooks: wb.RefreshAll: Next wb
Call macro_timer
End Sub
However code is not working as I wanted somewhere I am lacking, don't know where. pls help.thx
You could try:
Loop all open workbooks
Refresh
Code:
Option Explicit
Sub LoopOpenWorkbook()
Dim wb As Workbook
For Each wb In Application.Workbooks
wb.RefreshAll
Next wb
End Sub
I have multiple workbooks with worksheet named 'SUMMARY-F'. I need to combine these worksheets into one workbook and I am using the below code:
Sub CopySheets1()
Dim wkb As Workbook
Dim sWksName As String
sWksName = "SUMMARY-F"
For Each wkb In Workbooks
If wkb.Name <> ThisWorkbook.Name Then
wkb.Worksheets(sWksName).Copy _
Before:=ThisWorkbook.Sheets(1)
End If
Next
Set wkb = Nothing
End Sub
The code worked perfectly about 4 times however now when I run it, I get a subscript out of range error 9. Any tips on how to fix this?
Thanks,
Lucinda
If you have a workbook that is open that doesn't contain a sheet called SUMMARY-F you'll get an out-of-range error because Excel can't find a sheet with the specified name. This error will also apply to hidden workbooks such as a PERSONAL.xlsm if you've used it to record macros.
You should include a check in your code to handle the case when an open workbook doesn't have a sheet called SUMMARY-F.
See this question that gives options on how to identify if a sheet exists, such as defining a function that could be called from your code first:
How to check whether certain sheets exist or not in Excel-VBA?
You'll just need to modify it to check a sheet in another workbook, something like:
Public Function CheckSheet(ByVal sWB As String, ByVal sSheetName As String) As Boolean
Dim oSheet As Excel.Worksheet
Dim bReturn As Boolean
For Each oSheet In Workbooks(sWB).Sheets
If oSheet.Name = sSheetName Then
bReturn = True
Exit For
End If
Next oSheet
CheckSheet = bReturn
End Function
Then you can add a check in your code:
Sub CopySheets1()
Dim wkb As Workbook
Dim sWksName As String
sWksName = "SUMMARY-F"
For Each wkb In Workbooks
If wkb.Name <> ThisWorkbook.Name Then
If CheckSheet(wkb.Name,sWksName)
wkb.Worksheets(sWksName).Copy Before:=ThisWorkbook.Sheets(1)
End If
End If
Next
Set wkb = Nothing
End Sub
I open a workbook by using TASK MANAGER. Sometimes the previous task is not completed i.e. the macro is already running in another workbook.
I want to check if any other workbook is already open or running macro; close current opened workbook by task manager.
I have simple code as per below:
If thisworkbook.name <> activeworkbook.name then
call sendemail ' don't need code
else
Call Run_Dashboard
End if
Dim wb as Workbook
On Error Resume Next '//this is VBA way of saying "try"'
Set wb = Application.Workbooks(wbookName)
If err.Number = 9 then '//this is VBA way of saying "catch"'
'the file is not opened...'
End If
Function Is_Workbook_Open(byval WB_Name as String) as Boolean
Dim WB as Workbook
For each WB in Application.Workbooks
if WB.Name = WB_Name then
Workbook_Open = True
Exit Function
End if
Next WB
End Function
Answers True if the Workbook is opened, no error handling.