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.
Related
I'm building a spreadsheet macro that copies cells from one spreadsheet called DATA to a tab called REPORT based on criteria. If the criteria changes, the list clears and it adds the values that meet the new criteria. The macro is:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("B2:C5")
If Not Application.Intersect(KeyCells, Target) _
Is Nothing Then
For iRow = 2 To 5845
If Worksheets("DATA").Range("F" & iRow).Value = False Then
'Do nothing
Else
Worksheets("WORK").Cells(iRow, 1).Value = Worksheets("DATA").Cells(iRow, 4).Value
End If
Next iRow
End If
Call Worksheets("WORK").Delete_Blank_Rows
Sheets("REPORT").Range("E1:E5845").Value = Sheets("WORK").Range("A1:A5845").Value
Worksheets("REPORT").Columns(6).ClearContents
End Sub
Sub Delete_Blank_Rows()
On Error Resume Next
With Worksheets("WORK").Range("A2:A5845")
.Value = .Value
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
The spreadsheet is here: https://drive.google.com/file/d/1G-RQ9DvGKa_EEapcLIWDf3_SCdql_dJJ/view?usp=sharing
The error I receive is
runtime error saying object doesn't support property or method.
Any help is appreciated!
Your Call method of your worksheet object appears to be causing the issue.
You are attempting to call a SUB by using it as a child object of a worksheet:
Call Worksheets("WORK").Delete_Blank_Rows
needs to be changed to
Delete_Blank_Rows
Also, remove the Call keyword. You don't need it.
Call Statement (Visual Basic)
You can use the Call keyword when you call a procedure. For most procedure calls, you aren’t required to use this keyword.
You typically use the Call keyword when the called expression doesn’t start with an identifier. Use of the Call keyword for other uses isn’t recommended.
I have to run a set of code related to worksheet "wins", but only if that worksheet exist.
Please share a code to check the availability of sheet "wins". If worksheet "wins" exist, then only I want to run that set of code, else I want to skip executing that set of code and move to next line of code.
You could use On Error Resume Next to skip the errror which occurs if you try access a not existing worksheet and assigning it to a object variable. So if the worksheet does not exist, no error occurs but the variable is Nothing. If the worksheet exists, then the variable is not Nothing.
Example:
Sub test()
Dim wsWins As Worksheet
On Error Resume Next
Set wsWins = ActiveWorkbook.Worksheets("wins")
On Error GoTo 0
If Not wsWins Is Nothing Then
MsgBox "Worksheet wins exists."
Else
MsgBox "Worksheet wins does not exist."
End If
End Sub
Axel's answer will work nicely. Some people prefer not to use error throwing to test if something exists. If you're one of them then I use the following quite a lot in a Utility module. It'll work for Worksheets, Charts, etc. (basically anything that's a collection with a 'Name' property):
Public Function ExcelObjectExists(testName As String, excelCollection As Object) As Boolean
Dim item As Object
On Error GoTo InvalidObject
For Each item In excelCollection
If item.Name = testName Then
ExcelObjectExists = True
Exit Function
End If
Next
ExcelObjectExists = False
Exit Function
InvalidObject:
MsgBox "Developer error: invalid collection object passed in ExcelObjectExists."
ExcelObjectExists = False
End Function
You can call it like this:
If ExcelObjectExists("wins", ThisWorkbook.Worksheets) Then
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
Here is my issue, I have subs that work when I tested them with the sheet unlocked, but when I locked the sheet to protect certain cells from being selected or deleted/altered, the subs error out. So I need to add a part to my sub that unlocks, runs the main code, then re-locks the sheet.
I am looking for something like this
Sub Example ()
Dim sample as range
set sample as range("A3:Z100")
Application.ScreenUpdating = false
UN-PROTECT CODE
'Existing sub code here
RE-PROTECT CODE
Application.ScreenUpdating = True
End Sub
I am however unaware on what the code to achieve this should look like. I have tried researching and all I found was incomplete code that based on the comments, didn't work all the time. I did find a suggestion to upon error, have an error handler re-protect the sheet, but not sure how to write this either. Any suggestions?
Oh, and the people who will be using this sheet will not have access to the sheet password. I plan to have the module its self password protected and the subs attached to buttons. So placing the Sheet unlock password in the sub would be ok if it is needed.
Posting my original comment as an answer.
If you use the macro recorder and then protect & unprotect sheets, it will show you the code.
EDIT: Added the below.
If you attempt to unprotect a sheet that is not protected you will get an error. I use this function to test if a sheet is protected, store the result in a Boolean variable and then test the variable to see if a) the sheet must be unprotected before writing to it and b) to see if the sheet should be protected at the end of the proc.
Public Function SheetIsProtected(sheetToCheck As Worksheet) As Boolean
SheetIsProtected = sheetToCheck.ProtectContents
End Function
Do you need it to remove passwords? This worked for me
Sub macroProtect1()
Sheet1.Unprotect Password:="abc"
'Enable error-handling routine for any run-time error
On Error GoTo ErrHandler
'this code will run irrespective of an error or Error Handler
Sheet1.Cells(1, 1) = UCase("hello")
'this code will give a run-time error, because of division by zero. The worksheet will remain unprotected in the absence of an Error Handler.
Sheet1.Cells(2, 1) = 5 / 0
'this code will not run, because on encountering the above error, you go directly to the Error Handler
Sheet1.Cells(3, 1) = Application.Max(24, 112, 66, 4)
Sheet1.Protect Password:="abc"
ErrHandler:
Sheet1.Protect Password:="abc"
End Sub
had a similar problem and found this code on the web:
Sub protectAll()
Dim myCount
Dim i
myCount = Application.Sheets.Count
Sheets(1).Select
For i = 1 To myCount
ActiveSheet.Protect "password", true, true
If i = myCount Then
End
End If
ActiveSheet.Next.Select
Next i
End Sub
Sub Unprotect1()
Dim myCount
Dim i
myCount = Application.Sheets.Count
Sheets(1).Select
For i = 1 To myCount
ActiveSheet.Unprotect "password"
If i = myCount Then
End
End If
ActiveSheet.Next.Select
Next i
End Sub
Note that it is designed to protect / unprotect all sheets in the workbook, and works fine. Apologies, and respect, to the original author, I can't remember where I found it (But I don't claim it)...
The most common object that is Protected is the Worksheet Object This make it possible to preserve formulas by Locking the cells that contain them.
Sub Demo()
Dim sh As Worksheet
Set sh = ActiveSheet
sh.Unprotect
' DO YOUR THING
sh.Protect
End Sub
Here's my very simple technique for situations that don't require a password (which are most situations that I run into):
Dim IsProtected As Boolean
IsProtected = SomeWkSh.ProtectContents: If IsProtected Then SomeWkSh.Unprotect
'Do stuff on unprotected sheet...
If IsProtected Then SomeWkSh.Protect
You can, of course, simplify the syntax a bit by using a With SomeWkSh statement but if the "Do stuff..." part refers to properties for methods of a larger, spanning With statement object, then doing so will break that functionality.
Note also that the Protect method's Contents parameter defaults to True, so you don't have to explicitly specify that, although you can for clarity.
I have an XLA I'm use to make calculations and I'd like to create variables in the Name Manager to use in those calculations. I want to check to see if those named ranged already exist and if not let the user assign values to them. I have a Sub() that I'm using to set the Name Manager -example below- :
Public Sub SetNames()
On Error Resume Next
IsRangeName = CheckName("test")
If IsRangeName = Empty Then
Application.ThisWorkbook.Names.Add Name:="test", RefersTo:=0
End If
End Sub
If I go into the "Macro" menu and run the SetNames routine it works and sets test = 0 in the Name Manager.
However, what I want to do is run this through a Function and allow the function to use the variables in the Name Manager if they exist, if they don't exist then those values get set to an initial value in the Name Manager through the subroutine.
When I try to run the following code the values are never set in the Name Manager:
Sub Function1()
Call SetNames()
-Do Other Things-
End Function
All of the names are declared as global variables.
The intent is to have a user install the add-in and on the first function call using the add-in the Name Manager gets set, either to initialize the names or to allow the user to set the initial value. I don't want the user to go through the Macro ribbon option and execute the subroutine to initialize the Name Manager names.
Any help on this would be appreciated.
This seems to work in my quick testing, but you should be sure it performs in whatever your final use case is. It's a hack around the restrictions on a UDF being able to update the workbook, so it's outside of "normal" usage.
Sub SetNameIfMissing(swb As String)
Dim r As Name, wb As Workbook
Set wb = Workbooks(swb)
On Error Resume Next
Set r = wb.Names("test")
On Error GoTo 0
If r Is Nothing Then
Debug.Print "adding name..."
wb.Names.Add "test", 99
Else
Debug.Print "already added"
End If
End Sub
Function SetIt(v)
Dim wb
wb = Application.Caller.Parent.Parent.Name
'using Evaluate gets around the UDF restriction
Application.Caller.Parent.Evaluate "SetNameIfMissing(""" & wb & """)"
SetIt = "OK" 'or whatever return value is useful...
End Function
Not sure what "CheckName" is in your script - you didn't provide it .. however, I got it to work via:
1) comment out On Error Resume Next - this allows you to see CheckNames failing.
2) Replaced CheckNames with a loop to loop throw the defined names, looking for ours.
3) change your "function" definition from "sub" to "function".
test it, runs fine.
Sets the "test" name if it doesn't exist. Change it manually to another value, run again, doesn't touch it.
Public Sub SetNames()
'On Error Resume Next
For i = 1 To Application.ThisWorkbook.Names.Count
If Application.ThisWorkbook.Names(i).Name = "test" Then
IsRangeName = True
Exit For
End If
Next i
If Not IsRangeName Then
Application.ThisWorkbook.Names.Add Name:="test", RefersTo:=1
End If
End Sub
Function Function1()
Call SetNames
'-Do Other Things-
End Function