Sub fixdsd()
For q = 1 To 20
If ActivePresentation.Slides(40).Shapes(q).Name = "Wrong" Then
With ActivePresentation.Slides(40) _
.Shapes(q).ActionSettings(ppMouseClick)
.Action = ppActionRun
.Run = "Answer"
.AnimateAction = True
End With
On Error Resume Next
Next q
End If
End Sub
I'm getting a compile error: Next without For.
Can someone please point out how to correct it?
Related
I am having an issue using Resume and although I have found another solution by using an On Error GoTo, I am still confused as to why the code below doesn't work. The initial error occurs because the sheet name "Sheet_1" is already taken. This means that, in the watch window, err.number has a value of 1004 just before the Resume NameAgain is executed. Rather than clear the error and jump back up to the label, an error 20 occurs(resume without error), and the code moves to the End If line.
Given that there is an active error 1004, I can't understand why it acts as though there isn't an error. I have searched the site for Error 20 issues but nothing really resolved this for me or made me understand the logic behind it. Any help is much appreciated.
Sub ErrorTest()
Dim i as integer:i=1
NameAgain: On Error Resume Next
Worksheets("Main").Name = "Sheet_" & i
If Err.Number = 1004 Then
i = i + 1
Resume NameAgain
End If
End Sub
Update after paxdiablo comment:
The above was a poor attempt at trying to replicate but simplify a problem I was having. The section of code I am working with is below:
Activate CheckBook to use ActiveWindow
CheckBook.Activate
Set DestSheet = CheckBook.Worksheets.Add(After:=CheckBook.Sheets(1))
On Error Resume Next
v = 1
NameAgain: DestSheet.Name = ExpBookName & "_" & v
If Err.Number = 1004 Then
v = v + 1
Resume NameAgain
End If
On Error GoTo 0
ActiveWindow.DisplayGridlines = False
Set DestCell = DestSheet.Range("A2")
So the solution is to move the On Error Resume Next to the label line and use GoTo in place of Resume.
The resume statement is a means to, from within an error handler, go back to some point in your main (non-error-handling) code and resume execution.
In this case, you've explicitly stated you want to automatically resume next in the event of an error.
This is functionally equivalent to (VB-like pseudo-code):
line:
on error goto handler
cause error
resume line ' not in an error handler at this point '
handler:
resume next
So you're not technically in an error handler at the point where you try to resume to the label.
The right statement for what you're trying to do would be a simple goto rather than resume.
A more correct solution is to write code that does not deliberately generate errors or which does not use Goto.
Public Function GetNextSheetName(ByVal ipWb As Excel.Workbook, ByVal ipStemName As String) As String
Dim mySheet As Variant
Dim mySD As Scripting.Dictionary
Set mySD = New Scripting.Dictionary
For Each mySheet In ipWb.Sheets
' mySd.Count is a dummy entry to satisfy
' the Key and Item requirements for .Add.
' we are only interested in the Keys
' for use with the .Exists method later
mySD.Add mySheet.Name, mySD.Count
Next
Do
DoEvents
Dim myIndex As Long
myIndex = myIndex + 1
Dim myNextSheetName As String
myNextSheetName = ipStemName + "_" & CStr(myIndex)
Loop While mySD.Exists(myNextSheetName)
GetNextSheetName = myNextSheetName
End Function
Which now allows
Set DestSheet = checkbook.Worksheets.Add(After:=checkbook.Sheets(1))
DestSheet.Name = GetNextSheetName(checkbook, ExpBookName)
ActiveWindow.DisplayGridlines = False
Set DestCell = DestSheet.Range("A2")
Even though I clearly have the error blocked off
For Each sentence In ActiveDocument.Paragraphs
j = j + 1
On Error GoTo hey:
third_word(j) = sentence.Range.Words(3)
sw(j) = sentence.Range.Words(2)
tot_sent(j) = sentence.Range.Text
hey:
Next
The code is still throwing error 5941: the requested member collection does not exist. That is exactly the type of error that I'm trying to except and make the code continue. A lot of the paragraphs do not have a third word so I only want to put a sentence into the tot_sent array if the sentence has a third word. The best way to do this is through error handling but it is not working.
Try this:
For Each sentence In ActiveDocument.Paragraphs
j = j + 1
If sentence.Range.Words.Count > 2 Then
third_word(j) = sentence.Range.Words(3)
sw(j) = sentence.Range.Words(2)
tot_sent(j) = sentence.Range.Text
End If
Next
It is better to check for conditions that may cause errors, but if you really want to use On Error then you need to Resume once an error has occurred. If you don't Resume after processing the error, then you are still in "error handling" mode and any subsequent error cannot be trapped.
For Each sentence In ActiveDocument.Paragraphs
j = j + 1
On Error GoTo hey:
third_word(j) = sentence.Range.Words(3)
sw(j) = sentence.Range.Words(2)
tot_sent(j) = sentence.Range.Text
ResumePoint:
Next
'...
'...
Exit Sub
hey:
' perform whatever processing is required for the error
'...
Resume ResumePoint
End Sub
I've been trying to sort PivotTable objects in VBA using a function I've attempted:
Public Function PTSort(PTName As String, PTFieldName as String, SortArray As Variant)
Dim m as Integer: m = 1 'Row counter
Dim i as Long 'Dummy Variable for cycling
With ActiveSheet.PivotTables(PTName).PivotFields(PTFieldName)
.Parent.ManualUpdate = True
For i = LBound(SortArray) To UBound(SortArray)
With .PivotItems(SortArray(m - 1)) 'For in-code array
.Position = m
End With
m = m + 1
Next i
.Parent.ManualUpdate = False
End With
End Function
Whilst this works well with a known set of elements within SortArray, I have a master list to follow whilst sorting (so as to standardise a few orders accross several PivotTables), in which the PivotTable need not necessarily contain all said PivotItems. I have hence improved it to the following:
Sub PTSort(PTName As String, PTFieldName as String, SortArray As Variant)
Dim m as Integer: m = 1
Dim i as Long
Dim k As Integer: k = 1 'To cycle the position independently from the array in the event of disjoint.
With ActiveSheet.PivotTables(PTName).PivotFields(PTFieldName)
.Parent.ManualUpdate = True
For i = LBound(SortArray) To UBound(SortArray)
On Error GoTo ERRHANDLER:
With .PivotItems(SortArray(k)) 'After parsing from range of cells into VariantArray, then does one not require the "-1"
.Position = m
End With
m = m + 1
ExitHandler:
k = k + 1
Next i
.Parent.ManualUpdate = False
End With
GoTo ENDEND:
ERRHANDLER:
GoTo EXITHANDLER:
ENDEND:
End Sub
The OnError GoTo seems to only work once though, irregardless of how high up placed it?
Help would be greatly appreciated. Thanks in advance!
This is from MSDN on Visual Studio but I think it applies to VBA in the same way.
An "enabled" error handler is one that is turned on by an On Error statement. An "active" error handler is an enabled handler that is in the process of handling an error.
If an error occurs while an error handler is active (between the occurrence of the error and a Resume, Exit Sub, Exit Function, or Exit Property statement), the current procedure's error handler cannot handle the error. Control returns to the calling procedure
So after your code first gets to On Error GoTo ERRHANDLER, ERRHANDLER is enabled. Then when an error occurs ERRHANDLER is activated and handles the error. When you GoTo EXITHANDLER it stays active and still handles the error. The On Error GoTo ERRHANDLER has no effect at this point.
To re-enable the ERRHANDLER you need to use Resume EXITHANDLER instead of GoTo EXITHANDLER.
Edit on the Resume statement. There are three ways to use Resume: Resume, Resume Next and Resume label
Resume without an argument causes the code to resume at the line that caused the error. This obviously has to be used very careful as you must be absolutely certain that you fixed the problem or you'll end up in an infinite loop.
Resume Next causes the code to resume at the line after the line that caused the error.
Resume Label is almost the same as GoTo Label but with this you exit the error handler and resume normal code execution. The error handler is re-enabled.
i can not figure this out below is the code.... I hit the error for the 2nd case to open the form frmBookingLCL.show the form name is correct. I can't figure this out. the line with the **** us the error line. HELP!!
Public Sub SendBookingEmail()
StartTime = Timer
With Session
'check first 2 letters of shipper's code, if not US raise error
If IsStartPositionCorrect(5, 14, 2, "US") <> True Or IsStartPositionCorrect(5, 2, 8, "Customer") <> True And GetDisplayText(4, 20, 1) <> "0" Then
If MsgBox("You don't appear to be in Logis ocean export US file. Please enter the file first and then run the macro.", vbOKOnly, "Export file verification....") Then
Exit Sub
End If
End If
sTypeOfMessage = "booking"
sShipmentType = Trim(.GetDisplayText(9, 61, 3))
sFileType = Trim(.GetDisplayText(4, 32, 1))
bFullVersion = False
'On Error GoTo ErrHand
'Get Outlook if it's running
Set oOutlookApp = GetObject(, "Outlook.Application")
'collect data fields for the e-mail body
GetAllLogisDataBooking
'Blow up the question form
Select Case sShipmentType
Case "FCL", "CMF", "CCS", "FPR"
frmBookingFCL.Show
Case "LCL", "GWY", "CLD"
frmBookingLCL.Show**********ERROR HERE
Case Else
frmBookingFCL.Show
'frmBookingOthers.Show
End Select
End With
Finish = Timer
TimeTook = Finish - StartTime
MyMacroStats = GetProcedureStats("Booking Confirmation", TimeTook)
Exit Sub
ErrHand:
If Err = 429 Then
MsgBox "Please note you must start Microsoft Outlook first."
End
End If
End Sub
Most likely, the error is in your user form. See the code comments.
I tried to replicate the issue below:
Sub test()
'/Sub to load the user form.
Dim x As String
x = "a"
Select Case x
Case "a", "b", "c"
UserForm1.Show '/ It Will error-out here during debugging.
End Select
End Sub
Code in UserForm1
Private Sub UserForm_Initialize()
'/ Code from : https://msdn.microsoft.com/en-us/library/office/gg251554.aspx
'/ Actually the error happens here.
Dim RetVal ' Implicitly a Variant.
' Default property is assigned to Type 8 Variant RetVal.
RetVal = CreateObject("Excel.Application")
RetVal.Visible = True ' Error occurs here.
End Sub
So going by your intialize code, either you are missing or have incorrect name for one of these controls.
frTrucker,CheckBox1,txtPickupDate. Once you correct them, the error will be gone.
Summary: I want to do some basic error-handling
Problem: When I step through the code my "Error" block data gets run even when there isn't an error
-I'm pretty new to error handling in VBA and don't understand why the code in the Error block is run aside from me directing the code to enter the block. Thanks in Advance!
Code:
Function getReports()
startJournal = Sheets("Runsheet").Range("B5")
endJournal = Sheets("Runsheet").Range("E5")
If startJournal = 0 Or endJournal = 0 Then
GoTo Error
End If
'bunch of code
Error:
MsgBox ("Error Statement")
End Function
You need Exit Function before the error label.
i.e. the code should hit the label (eh) only in case of error & exit otherwise.
Function getReports()
on error goto eh
startJournal = Sheets("Runsheet").Range("B5")
endJournal = Sheets("Runsheet").Range("E5")
If startJournal = 0 Or endJournal = 0 Then
GoTo Error
End If
'bunch of code
Exit Function
eh:
MsgBox ("Error Statement")
End Function
Looking at your code, you could write it as
Function getReports(startJournal as integer, endJournal as integer) as Boolean
If startJournal = 0 Or endJournal = 0 Then
msgbox "startJoural or endJournal should not be 0."
exit function '** exiting will return default value False to the caller
End If
'bunch of code
getReports = True
End Function
On the caller's side
if getReports(Sheets("Runsheet").Range("B5"), Sheets("Runsheet").Range("E5")) then
call faxTheReport '** This function will be called only if getReports returns true.
end if
Here is how I generally deal with errors in my VBA code. This was taken from code in a class that automates an instance of Internet Explorer (the IE variable). The Log is used to inform the user of what's going on. The variable DebugUser is a boolean which I set to true when I'm the one running the code.
Public Sub MyWorkSub()
On Error GoTo e
Nav "http://www.somesite.com"
DoSomeSpecialWork
Exit Sub
e:
If Err.Number = -2147012894 Then
'timeout error
Err.Clear
Log.Add "Timed Out... Retrying"
MyWorkSub
Exit Sub
ElseIf Err.Number = -2147023170 Or Err.Number = 462 Or Err.Number = 442 Then
RecoverIE
Log.Add "Recovered from Internet Explorer Crash."
Resume
ElseIf Err.Number = 91 Then
'Page needs reloading
Nav "http://www.somesite.com"
Resume 'now with this error fixed, try command again
End If
If DebugUser Then
Stop 'causes break so I can debug
Resume 'go right to the error
End If
Err.Raise Err.Number
End Sub