Is there a way to say to the code that, everytime there is an error, cancel what it's previously done?
For example, I have a code which creates 6 workbooks and when there is an error at the half of the code I have to cancel every workbook and launch the macro again!
thanks in advance
You can try:
Application.UnDo
in your error code. It does not always work.
VBA execution causes the Undo history to be erased
code that changes the interface in any way will clear the Undo buffer (stack)
the history is a list (or collection) of strings
Application.CommandBars("Standard").Controls("&Undo").Control.ListCount is 0
but you might be able to do something like this
Option Explicit
Public Sub makeFiles()
Dim i As Long, currentWB As Long, newWBs As Long
On Error GoTo cancelAction
currentWB = Workbooks.Count
For i = 1 To 6
Workbooks.Add
newWBs = newWBs + 1
ActiveSheet.Cells(1, 1).Value = 4
'generate an error
If i = 3 Then Workbooks.Item(Workbooks.Count + 1).Activate
Next
cancelAction:
Do While newWBs > 0 'Workbooks.Count > 1
Workbooks(currentWB + newWBs).Close False
newWBs = newWBs - 1
Loop
End Sub
Related
I am getting an error as Runtime error 7 while running the cleanup names utility as mentioned in code below. I am using 512 GB HDD, 8 GB RAM, I7 processor so should not be a memory issue and still the issue pops up.
My workbook has 123188 defined names which I want to delete using the code below. Is there a way to be more efficient with the code / does someone has a code / built in addin which I can incorporate in a master addin?
The function breaks at
For Each objName In ActiveWorkbook.Names
Any help will be appreciated.
Thanks in advance
Option Explicit
Sub Cleanup_names123()
'
'Deletes all names except for Print_Area, Database, and DB
'Declare variables
Dim objName As Name
Dim strAnswer As String
'Display instructions
strAnswer = MsgBox("This function will delete all named ranges except Print_Area, DB, and Database. If you are not ready to proceed click Cancel to exit.", vbOKCancel)
'If cancelled - exit function
If strAnswer = vbCancel Then End
'If no names found, exit
If ActiveWorkbook.Names.Count = 0 Then
MsgBox "No names found. Macro complete."
End
End If
MsgBox ActiveWorkbook.Names.Count & " name(s) found. It may take a few minutes for the cleanup."
'Delete names
For Each objName In ActiveWorkbook.Names
On Error Resume Next
If InStr(objName.Name, "Database") <> 0 Then
'If Database - no action
ElseIf InStr(objName.Name, "database") <> 0 Then
'If database - no action
ElseIf InStr(objName.Name, "DB") <> 0 Then
'If database - no action
Else
objName.Delete
ThisWorkbook.Names(objName.Name).Delete
End If
Next
On Error GoTo 0
End Sub
If iterating the collection is taking up too much memory you can manually select each item one by one. When deleting items it's important to work backwards from the end because when you delete item 1 then item 2 becomes item 1. So we use Step -1 to work backwards.
To make your guard clause read plainly and avoid empty Ifs I changed the logic to If Not And. I find this more clear. Don't use underscore _ in method names because that is reserved for Event methods.
Option Explicit
Public Sub CleanupNames()
'
'Deletes all names except for Print_Area, Database, and DB
'Declare variables
Dim strAnswer As String
'Display instructions
strAnswer = MsgBox("This function will delete all named ranges except Print_Area, DB, and Database. If you are not ready to proceed click Cancel to exit.", vbOKCancel)
'If cancelled - exit function
If strAnswer = vbCancel Then Exit Sub
Dim NamesCount As Long
NamesCount = ActiveWorkbook.Names.Count
'If no names found, exit
If NamesCount = 0 Then
MsgBox "No names found. Macro complete."
Exit Sub
End If
MsgBox NamesCount & " name(s) found. It may take a few minutes for the cleanup."
'Delete names
Dim iter As Long
For iter = NamesCount To 1 Step -1
Dim objName As String
objName = ActiveWorkbook.Names.Item(iter).Name
On Error Resume Next
If Not InStr(objName, "Database") <> 0 And _
Not InStr(objName, "database") <> 0 And _
Not InStr(objName, "DB") <> 0 Then
ActiveWorkbook.Names(objName).Delete
End If
If iter Mod 5000 = 0 Then ActiveWorkbook.Save
Next iter
End Sub
UPDATE: Added the save code and changed the delete behavior.
Try this. The approach I took was to run a loop backwards from the bottom so that excel doesn't move the items up each time one is deleted and deleting via Index number rather than name. I also made the test a little more efficient I think.
Option Explicit
Sub DeleteNames()
Dim NameCount As Long
Dim Cntr As Long
Dim WkBk As Workbook
Dim TestName As String
Set WkBk = ThisWorkbook
NameCount = ActiveWorkbook.Names.Count
'Delete names
With WkBk
For Cntr = NameCount To 1 Step -1
On Error Resume Next 'not sure you need this but can't hurt
TestName = UCase(.Names(Cntr).NameLocal)
If InStr(TestName, "DATABASE") > 0 Or _
InStr(TestName, "DB") > 0 Then
'If database - no action
Else
.Names(Cntr).Delete
End If
Next Cntr
End With 'WkBk
End Sub
HTH
It may be as simple as turning off calculation and screen updates... this should increase stability and greatly increase speed.
So, before your For...Next loop -
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Then after your For...Next loop -
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
You should also consider running those last two lines after trapping any errors so that you don't leave the settings inactive.
Here is the extra bit about saving you asked for. I haven't coded up your solution as you should be able to modify this accordingly. This counts backwards from 50 and saves every 5 times through the loop with a debug statement so you can see that it works.
Sub quickSaveDemo()
Dim counter As Integer
counter = 50
For i = counter To 1 Step -1
Debug.Print "Loop count - " & i & " - Other stuff here"
If i Mod 5 = 0 Then
Debug.Print "Save here"
ActiveWorkbook.Save
End If
Next i
End Sub
I am writing some code that opens up a number of files via a url. This all works fine, however after a while the server I am pulling this data from blocks me, which is throwing up an error message.
What I have tried to do is create an error handler that resets the error and then continues from the top after waiting 5 seconds. I have tried two things
On error resume next, to skip that line. This doesn't seem to do anything as the code still times out.
Go to error handler, wait 5 seconds, reset the error and then continue where the code already was.
Any ideas what I am doing wrong. example file paths below;
https://query1.finance.yahoo.com/v7/finance/download/GBPUSD=X?period1=946684800&period2=9999999999&interval=1d&events=history
https://query1.finance.yahoo.com/v7/finance/download/GBPCNY=X?period1=946684800&period2=9999999999&interval=1d&events=history
https://query1.finance.yahoo.com/v7/finance/download/^NZ50?period1=946684800&period2=9999999999&interval=1d&events=histor
Sub TESTING()
Call START
Dim i As Integer
Workbooks("SHARE PRICE CREATOR.xlsb").Sheets("links").Activate
For i = 2 To Application.WorksheetFunction.CountA(Range("E:E"))
xtable = Cells(i, 5)
xURL = Cells(i, 4).Value
CONTINUE:
On Error GoTo Errhandle
Workbooks.Open xURL, FORMAT:=6, DELIMITER:=","
Workbooks("SHARE PRICE CREATOR.xlsb").Sheets("links").Activate
Cells(i, 6) = "OK"
Next
Errhandle:
On Error Resume Next
If Err.Number > 0 Then
Cells(i, 6) = Err.Number
End If
On Error GoTo 0
Application.Wait (Now + TimeValue("0:00:5"))
GoTo CONTINUE
Call ENDING
End Sub
Thanks
Scott
Some pointers:
I don't think the On Error Resume Next serves any purpose in your ErrHandle
Put Workbooks("SHARE PRICE CREATOR.xlsb").Sheets("links") into a variable and qualify your range calls with that
Avoid implicit Activesheet references
Use Err.Clear to clear error
You will need an Exit Sub for successful completion of all tasks before running into your error handler
You need an exit strategy to avoid potential for infinite loop. I personally would go with a max retries strategy before moving
onto next url and also have a wait every x number of requests to be a good netizen
Generally avoid the spaghetti code effect of GoTo
Declare all your variables with their type. Remove if not used. Use Option Explicit to enforce
Generally:
I don't like GoTos as makes code hard to read and debug. See a possible re-write, with further comments, below:
TODO:
Refactor out code to be less nested with use of helper functions/subs i.e. be more modular.
Code:
Option Explicit 'Use Option Explicit
Public Sub RetrieveYahooData()
Const MAX_RETRIES As Long = 3
Dim i As Long, ws As Worksheet, lastRow As Long 'use Long
Dim wbMain As Workbook, wb As Workbook, xUrl As String 'declare xUrl
Dim xtable As String 'temp assignment.
Start 'what subs are these?
Set wbMain = Workbooks("SHARE PRICE CREATOR.xlsb") ''Put in a variable. This assumes is open.
Set ws = wbMain.Worksheets("links")
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row 'You want to count from row 2 I think
If lastRow >= 2 Then
For i = 2 To lastRow
If i Mod 100 = 0 Then Application.Wait Now + TimeSerial(0, 0, 5) 'every n e.g. 100 requests have a pause
numberOfTries = 0
With ws
xtable = .Cells(i, 5).Value '?What is xTable and its datatype? _
Declare it and use Option Explicit at top of code. _
Also, where will it be used?
xUrl = .Cells(i, 4).Value
If xUrl <> vbNullString Then
Do
DoEvents
On Error Resume Next
Set wb = Workbooks.Open(xUrl, Format:=6, DELIMITER:=",") 'add other tests for valid url?
On Error GoTo 0
If Not wb Is Nothing Then 'remember to save and exit do
wb.SaveAs wbMain.Path & "\" & wb.Name, AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges 'Credit to #Sorceri https://stackoverflow.com/a/14634781/6241235
wb.Close True
Exit Do
Else
Application.Wait Now + TimeSerial(0, 0, 5)
End If
Loop While numberOfTries < MAX_RETRIES
End If
End With
ws.Cells(i, 6) = IIf(wb Is Nothing, "FAIL", "OK")
Set wb = Nothing
Next
End If
ENDING
End Sub
So here's my objective: I need to execute different macros deppending on a multiple choice ListBox. I am a begginner with vba and some tasks get a bit harder for me at the moment.
there's a multiple choice ListBox with 9 options. If you choose the option "Exfoliación", it executes the macro called "macro4". This is fully customizable, so if I choose from the ListBox the option "Exfoliación" and "Estanqueidad", it will execute the macros 4 and 3 (the ones related to them).
I've seen some example surfinf the Internet, but they're about ListBox's working with columns, sheets, and so on. But there weren't much explanations working with macros.
The user selects the options and presses a Submit button in the worksheet called "Botón". the choices from the Listbox are marked with vector(i)=1. With a for loop the choices are read and executes the corresponding macros to those choices with the array a(i) that contains the names of those macros.
Sub Submit()
'Getting selected items in ListBox1
Dim vector(1 To 11) As Integer
Dim i As Integer
Dim a(1 To 9) As String
'Private Sub CommandButton1_Click()
For i = LBound(a) To UBound(a)
vector(i) = 0
Next i
With Sheets("Botón").ListBox1
Select Case (ListBox1.Text)
Case "Tornillo Resorte": vector(1) = 1
Case "Categoría Manguito": vector(2) = 1
Case "Estanqueidad": vector(3) = 1
Case "Exfoliación": vector(4) = 1
Case "Material vaina": vector(5) = 1
Case "Diseño EC": vector(6) = 1
Case "Curva Q vs Enriquecimiento": vector(7) = 1
Case "Curva Criticidad": vector(8) = 1
Case "Curva de carga t. enfriamiento": vector(9) = 1
Case "Condicioón de transporte": vector(10) = 1
Case "ATI": vector(11) = 1
Case ""
MsgBox "nothing selected"
Case Else
MsgBox Me.ListBox1.Text
End Select
Dim MN As String
For i = 1 To N 'Fill the array
a(i) = "macro" & i
Next
MN = "Módulo5" 'Module where i have the worksheet I'm working with
Dim N As Integer
N = 11
For i = LBound(a) To UBound(a)
If vector(i) = 1 Then
Application.Run MN & "." & a(i)
End If
Next i
End Sub
I find trouble with the Select Case (ListBox1.Text) statement.
It doesn't compile and don't know how to call the listBox with Select Case.
thank you in advance for your help :)
Edit: with a new code. Method with selection:
`Private Sub Command Button1_Click() 'This is a button that opens the multilist with the different options. It works correctly
Worksheets("Botón").ListBox1.Clear
ListBox1.Height=200
ListBox1.Width=250
Dim mylist As Variant
mylist=Array("Tornillo Resorte",...,"Condicioón de transporte")
ListBox1.List=mylist
End Sub
Sub Submit() ''here's the macro with the button assigned to execute the selection. This is where I get the problem.
With Sheets("Botón").ListBox1
MN = "Módulo5" 'Module where i have the worksheet I'm working with
For X = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(X) = True Then
Application.Run MN & "." & .ListIndex + 1
Else
MsgBox "No se ha seleccionado ningún filtro"
End If
Next X
End With
End Sub
If you only wanted to select one macro - and assuming the macros are named sequentially macro1 to macrox, then you can just do this:
Sub Submit()
With Sheets("Botón").ListBox1
if .listindex = -1 then
MsgBox "nothing selected"
Else
MN = "Módulo5" 'Module where i have the worksheet I'm working with
Application.Run MN & "." & .listindex +1
End If
End With
End Sub
If you want to do more than one then you need to loop through the .selected array calling the macros sequentially
I want to copy information from cells in M79to PAlysis.
My Sub PopulateFields is located in PAlysis.
What is wrong with my reference to a different file?
Sub PopulateFields()
Dim Mur As Workbook, TOMS As Workbook, i As Integer, LastRow As Integer, j As Integer
Set Mur = Workbooks("S:\M\ BPM\M79.xls")
Set TOMS = Workbooks("S:\M\BPM\PAlysis.xlsm")
Set TOMSPos = TOMS.Worksheets("Positions")
Set TOMSAna = TOMS.Worksheets("Analysis")
Set MurexWs = Murex.Worksheets("BB_Overview")
LastRow = Murex.Cells(MurexWs.Rows.Count, 1).End(xlUp).Row
j = 3
For i = 3 To LastRow - 1
If Mur.MurexWs.Cells(i, 2).Value = "Bond" Then
Mur.MurexWs.Cells(j, 6).Copy TOMS.TOMSPos.Cells(i + 1, 1)
j = j + 1
Else
j = j + 2
End If
Next i
End Sub
In the lineSet Mur = ... I get
Error 9: Subscript out of range.
You could use the following to either get an already opened workbook, or open it if it is not opened.
Sub test()
Set mur = GetOrOpenWorkbook("S:\M\BPM\", "M79.xls")
Set toms = GetOrOpenWorkbook("S:\M\BPM\", "PAlysis.xlsm")
End Sub
Public Function GetOrOpenWorkbook(Path As String, Filename As String) As Workbook
'test if workbook is open
On Error Resume Next
Set GetOrOpenWorkbook = Workbooks(Filename)
On Error GoTo 0
'if not try to open it
If GetOrOpenWorkbook Is Nothing Then
Set GetOrOpenWorkbook = Workbooks.Open(Filename:=Path & Filename)
End If
End Function
I assume that you want to open the workbooks: You have to use Workbooks.open. This opens a workbook in Excel (basically the same as opening it via File->Open in Excel)
Set Mur = Workbooks.open("S:\M\ BPM\M79.xls")
(not sure about the space before BPM - check if this is a typo.
If your workbook is already open, the command would be
Set Mur = Workbooks("M79.xls")
This is the syntax for VBA Collections where you can access an object either by (numeric) index or via it's name. The name of a workbook within the Workbooks-collection is the filename, but without the path (this is the reason that you cannot open 2 workbooks with the same name, even if they are stored in different folders).
When you try to access a member of a collection that doesn't exist, VBA will throw the Runtime Error 9.
I am working in Excel 2016. I currently created a macro that will loop through all open workbooks and grab the data in them if they start with the word "report". The issue I am trying to solve now is how to enable editing. If the users enable editing after downloading all reports to be combined there is no issue with the macro. They run into issues with the macro not grabbing the data if they missed that button.
While they are not working with that many workbooks, I am trying to make it easier for them. The code that I have posted will do the first 3 workbooks and then continue looping through the remaining 5 but will not "Enable Edit".
Sub EnableEdit()
Dim bk As Workbook
Dim w As Long, wCount As Long
wCount = Application.ProtectedViewWindows.Count
Set wsh = ThisWorkbook.Worksheets("Data")
On Error Resume Next
If wCount > 0 Then
For w = 1 To wCount
Application.ProtectedViewWindows(w).Activate
Application.ProtectedViewWindows(w).Edit
If Left(ActiveWorkbook.Name, 6) = "report" Then
ActiveWorkbook.Worksheets(1).Range("A1:Z1").Copy _
Destination:=wsh.Range("A1")
nrow = wsh.Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveWorkbook.Worksheets(1).Range("A2:Z500").Copy _
Destination:=wsh.Range("A" & nrow)
ActiveWorkbook.Close
End If
Next w
End If
On Error GoTo 0
End Sub
Application.ProtectedViewWindows appears to be a collection of all the protected-view windows. As soon as you execute the .Edit method on one of those protected-view windows it is no longer in protected-view mode and is therefore removed from the collection.
This means that when you Edit the first member of the collection (when w is 1), what was the second member now becomes the first member, what was the third member now becomes the second, etc. And then on the next iteration of your loop (when w is 2) your code is therefore looking at the original third member, having completely ignored looking at the original second member.
The easiest way to fix the issue is to loop through the array in reverse order, i.e. use:
For w = wCount To 1 Step -1