Continuing a function - vba

I'm trying to write a VBA macro where it analyzes multiple sheets of data in the same excel file. I currently have it set so that when it's analyzing all the various sheets, when it finds an error, it stops the program completely. I have figured out how to get it to go to the next sheet but cannot get the program to continue running. Here is what I have so far:
`If Counter > 480 Then
Worksheets(ActiveSheet.Index + 1).Select
End
End If`
I know the End function ends running the program but when I take it out it does not work, how can I get the program to continue running as it was before it reaches the sheet with the error?

Put the loop that you want to end in a separate function or sub, then when the error is found, use
Exit Function
or
Exit Sub
if it's a sub.
Simple example using your code:
Sub Main
OtherSub
'Continue here
End Sub
Sub OtherSub
If Counter > 480 Then
Worksheets(ActiveSheet.Index + 1).Select
Exit Sub
End If
End Sub

Related

Simple Error Handling for GoTo or Other

I'm attempting to create a macro that will allow a User to click a button and the excel sheet will either 1: Move to the next/previous sheet or 2: Copy existing sheet and then move to the copied sheet.
Currently I'm stuck dealing w/ a error handling situation and am not sure how to get around it. I'm not sure if I'm using the On Error correctly. Essentially I need it to go to my next sub if a page doesn't exist. If the page does exist, to simply ActiveSheet.Index + 1 then select.
Sub Function1()
On Error GoTo fixer
Sheets(ActiveSheet.Index + 1).Select
fixer:
Call Copier2
End Sub
Sub Copier2()
ActiveWorkbook.ActiveSheet.Copy _
After:=ActiveWorkbook.ActiveSheet
End Sub
Any help is greatly appreciated, I'm quite a novice at this stuff so don't be afraid to dumb it down for me.
Let's have some fun with this, to illustrate the mechanics.
First let's extract a method whose job is to activate a given worksheet. That method will return a Boolean value that indicates whether it succeeded or not. Because we want to return a value, this will be a Function procedure:
Private Function ActivateSheet(ByVal index As Long) As Boolean
Dim result As Boolean
On Error GoTo CleanFail
ActiveWorkbook.Sheets(index).Select
result = True
CleanExit:
ActivateSheet = result
Exit Function
CleanFail:
Err.Clear
result = False
Resume CleanExit
End Function
The "happy path" assigns result to True and then assigns the function's return value to result and then returns.
The "error path" jumps to CleanFail, which clears the error (likely some index out of bounds error), assigns result to False and then Resume CleanExit clears the error-handling state and resumes to CleanExit, which assigns the function's return value to result and then returns.
The macro can do this now:
Public Sub NavigateRight()
If Not ActivateSheet(ActiveSheet.Index + 1) Then
'copy the current sheet if there's no next sheet:
ActiveSheet.Copy After:=ActiveSheet
End If
End Sub
And we can also have this one:
Public Sub NavigateLeft()
If Not ActivateSheet(ActiveSheet.Index - 1) Then
'copy the current sheet if there's no previous sheet:
ActiveSheet.Copy Before:=ActiveSheet
End If
End Sub
Don't make procedures just for the sake of making procedures: use them to abstract concepts: a procedure like Copier2 doesn't really need to exist, it's just wrapping a single call against the Excel object model - better to inline it IMO.

1004 Error on simple Sub

I'm having a 1004 error in the code below. Its such as simple routine, I can't figure out what's wrong. This is only one sub of many in Module 1. Note that UserForm2's code works fine when I run it from the forms Sub's. But when I call it from here, I get the 1004 error. I don't really understand what causes that error. Help appreciated. Note that ChosenString and Report is a Public variable. You have several 1004 error entries, but I can't find one that fits this problem. Error is on UserForm2.Show.
Sub ChooseReport()
' Display a selection box of reports and run the report
'
ChoseCancel = 0
Sheets("Codes").Activate
UserForm2.Show ' Displays selection box of reports
'
' If the Cancel button was selected, exit the sub
If ChoseCancel = 1 Then
Sheets("Reports").Activate
Exit Sub
End If
'
' Trim returned value of the comma
StringLength = Len(ChosenString)
Report = Left(ChosenString, StringLength - 2)
'
End Sub
This is my UserForm2 Code. It works fine.
Sub UserForm_Initialize()
' Fill the list box with appropriate values
'
UserForm1.ListBox1.ListStyle = fmListStylePlain
Sheets("Codes").Activate
Range("O4").Select
'
' Fill List box with appropriate cells entries for Reports
With ListBox1
Do While ActiveCell.Value <> Empty
.AddItem ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
End With
End Sub
Found it. I had copied the code from UserForm1, and hadn't changed a reference to UserForm1 to UserForm2. My error went away.

Exiting procedure that has called a different procedure VBA Excel

I have a procedure that does some error checking for me and is called from a different procedure. What I want to be able to do is that if incorrect data has been entered and the error checking procedure finds this then I want to stop the procedure that called the error checking procedure. i.e. if error checking procedure is
sub errorCheck
and main procedure is
sub main
and main calls error checking. when error is found I want sub errorCheck to stop main. I have tried to use exit sub but this exits only the errorCheck sub not main
and help would be great thanks
Make it a function that returns a Boolean. Check if the value is False in the calling procedure main and then do an Exit Sub in the main procedure.
A bit nastier way to do it: Just type End instead of Exit Sub. This does however stop the execution of the code completely.
Something like this:
Function errorcheck() As Boolean
' in this case it is always false of course
errorcheck = False
End Function
Sub main()
If Not errorcheck Then
Exit Sub
End If
End Sub
You can use global object Err to complete this task.
Look at the example below:
Sub main()
'(...)
On Error Resume Next
Call errorChecking
If VBA.Err.Number = 999 Then
Exit Sub
End If
On Error GoTo 0
'(...)
End Sub
Sub errorChecking()
If Error Then
Call VBA.Err.Raise(999, "errorChecking", "Error found")
Exit Sub
End If
End Sub
Before we invoke function errorChecking we instruct VBA that it shouldn't stop if any error occurs - it should just ignore it and go to the next line of code instead.
Inside errorChecking function there is a conditional statement that checks if error occurred.
In case the error occurred, this function raise a new error with the number defined by you (999 in my example, you can come up with your own number).
Back in the Main function we check if the current number of VBA.Err object is 999. If it is, it means the error was raised by the function errorChecking and we can leave the Main sub.
Here is a simple example based on Tom's answer:
Sub MAIN()
Dim rng As Range, CellIsNogood As Boolean
Set rng = Application.InputBox(Prompt:="Enter range", Type:=8)
Call ErrorCheck(rng, CellIsNogood)
If CellIsNogood Then
MsgBox "error in range"
End If
End Sub
Sub ErrorCheck(r As Range, b As Boolean)
Dim rr As Range
b = False
For Each rr In r
If IsError(rr.Value) Then
b = True
End If
Next rr
End Sub
After seeing what Tom and had said I did a bit of research and got this working. Below is the code that I used. Thanks for the other answers :)
Private Function errorCheckingBox(box1, message) As Boolean
If Len(box1.value) = 0 Then
MsgBox message, vbExclamation, "Invalid Selection" ' displays a messgae box
box1.SetFocus
errorCheckingBox = True
End If
End Function

Excel macro doesn't update correctly

i have created macro for excel but it seems somewhere i have done something wrong,
i want to fetch an image from a URL and then update it up to 1 second (more or less)
Sub GetPicture()
PictureURL = "This is where i put the URLi want"
Set MyPict = ActiveSheet.Pictures.Insert(PictureURL)
Cells(1).Value = Now
nextTime = Now + TimeValue("00:00:01")
End Sub
when i run the macro doesn't do anything,only when i press f5 the it updates as fast as i press f5,also what is the value to update less than 1 second ("00:00:01"),when i try ("00:00:0.5") it comes up with "run time error 13" "type mismatch"
Any help is very much apreciated.
In Excel, you can use VBA to trigger code that updates a Worksheet on specific intervals. The code below shows how you would activate a Timer each time the Worksheet is activated by a user. Whenever the Timer fires (on 1 second intervals here) this code updates Cell A1 in the ActiveSheet with the current Time.
To further customize, you would add code to the OnTimerMacro in order to update a Picture or whatever else you recurring task might be.
(Props to Hartmut Gierke for his post on the topic.)
Option Explicit
Dim Execute_TimerDrivenMacro As Boolean
Sub Start_OnTimerMacro()
Execute_TimerDrivenMacro = True
Application.OnTime Time + TimeValue("00:00:01"), ActiveSheet.Name & ".OnTimerMacro"
End Sub
Sub Stop_OnTimerMacro()
Execute_TimerDrivenMacro = False
End Sub
Public Sub OnTimerMacro()
If Execute_TimerDrivenMacro Then
' Do something e.g. put the actual time into cell A1 of the active sheet
ActiveSheet.Cells(1, 1).Value = Time
' At the end restart timer
Application.OnTime Time + TimeValue("00:00:01"), ActiveSheet.Name & ".OnTimerMacro"
End If
End Sub
Private Sub Worksheet_Activate()
'Start the timer driven method when opening the sheet
Start_OnTimerMacro
End Sub
Private Sub Worksheet_Deactivate()
'Stop the timer driven method when opening the sheet
Stop_OnTimerMacro
End Sub
if you would like the macro to repeat you have to put it in a do...until loop. The only problem, is that you can't really have the macro run all the time. There has to be a way to stop it. The do...until loop will help with this, but you have to come up with a reasonable exit from the loop. Can you give a little more background as to what you ultimately want this to do?
Also it sounds like you want the running of the macro to be triggered by something other than the pressing of F5. Can you explain when you would like to see it start?

Need VB to make Excel calculate a sheet or range in realtime and in the background

How can I make excel continuously calculate a sheet/range in realtime (not 1 calc/sec) and do it in the background?
I want this metric clock to run like a stopwatch....
=IF(LEN(ROUND((HOUR(NOW())*(100/24)),0))=1,"0"&ROUND((HOUR(NOW())*(100/24)),0),ROUND((HOUR(NOW())*(100/24)),0))&":"&IF(LEN(ROUND((MINUTE(NOW())*(100/60)),0))=1,"0"&ROUND((MINUTE(NOW())*(100/60)),0),ROUND((MINUTE(NOW())*(100/60)),0))&":"&IF(LEN(ROUND((SECOND(NOW())*(100/60)),0))=1,"0"&ROUND((SECOND(NOW())*(100/60)),0),ROUND((SECOND(NOW())*(100/60)),0))
I've used the following to produce the effect you are looking for:
Option Explicit
Public TimerRunning As Boolean
Dim CalculationDelay As Integer
Public Sub StartStop_Click()
If (TimerRunning) Then
TimerRunning = False
Else
TimerRunning = True
TimerLoop
End If
End Sub
Private Sub TimerLoop()
Do While TimerRunning
'// tweak this value to change how often the calculation is performed '
If (CalculationDelay > 500) Then
CalculationDelay = 0
Application.Calculate
Else
CalculationDelay = CalculationDelay + 1
End If
DoEvents
Loop
End Sub
StartStop_Click is the macro that I tie to the Start/Stop button for the stopwatch. You can get fancy, and change its name to "Start" or "Stop" depending on the value of TimerRunning, but I kept things simple to illustrate the concept.
The two key things here are:
Application.Calculate
Which forces Excel to calculate the worksheet, and:
DoEvents
Which allows VBA to run in the background (i.e. Excel does not stop responding to user input). This is what allows you to still press the "Stop" Button even though the timer is running.
I think this might fail your "(not 1 calc/sec)" criteria, but I achieved something similar as follows. Assumes your formula is in cell A1 of a worksheet named Sheet1.
In the ThisWorkbook code module:
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:01"), "RecalculateRange"
End Sub
... and in a regular code module:
Public Sub RecalculateRange()
Sheet1.Range("A1").Calculate
Application.OnTime Now + TimeValue("00:00:01"), "RecalculateRange"
End Sub