Activate sheet 1 otherwise another sheet - vba

Hi I tried to modify the following two lines of code by adding an if statement, but it didn't work. Does anyone know why?
Workbooks(wkbk_Record).Activate
Workbooks(wkbk_Record).Sheets("Tab1").Select
What's wrong with the following? Thank you
If SheetExists("Tab1", Workbooks(wkbk_Record)) Then
Workbooks(wkbk_Record).Activate
Workbooks(wkbk_Record).Sheets("Tab1").Select
Else
Workbooks(wkbk_Record).Activate
Workbooks(wkbk_Record).Sheets("Tab2").Select

Considering that you take the SheetExists from here - Test or check if sheet exists this is something that works:
Sub TestMe()
If SheetExists("Tab1") Then
Sheets("Tab1").Select
ElseIf SheetExists("Tab2") Then
Sheets("Tab2").Select
Else
MsgBox "No Sheet"
End If
End Sub
Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtName)
On Error GoTo 0
SheetExists = Not sht Is Nothing
End Function
Or if you wanna see your colleagues get crazy, write it like this:
Sub ActivateTab2OrTab1()
On Error Resume Next
Sheets("Tab2").Select
Sheets("Tab1").Select
End Sub

Related

vba assigning sub routine to variable

I have the following sub routine (in module10).
Sub varWorksheet(wksht As String)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(wksht)
Set ws = Nothing
End Sub
I want to be able to pass this sub routine as a reference to a variable with something like this rather than have to declare it explicitly in each routine:
Set ws = module10.varWorksheet("Sheet1")
I'm getting a compilation error -> expected Function or Variable.
You shoud use a function like this.
Function varWorksheet(wksht As String) As Worksheet
On Error Resume Next
Set varWorksheet = ThisWorkbook.Sheets(wksht)
End Function
It will return nothing if the worksheet doesn't exist. This works fine.
Sub Test()
Dim ws As Worksheet
Set ws = Modul10.varWorksheet("Tabelle4")
If ws Is Nothing Then
Debug.Print "No worksheet"
Else
' what ever you want
End If
End Sub

returning object that caused error to a global errorhandler

i have written the following code which uses a global errorhandler that rectifies the error and resumes code again. right now i have labelled the lines and using 'Erl', i am checking which line caused the error and then accordingly finding the object and creating it.
What i want to do is to pass the object that caused the error to the errorhandler itself and then create that object and return control back to main procedure to resume from where it left off.
How to return the object that caused the error to an error handler? this way it would be more appropriate to handle some errors, instead of just returning an error message and error description.
as an example, i am letting the errorhandler handle creation of sheets if they are non-existent.
Option Explicit
'Worksheets: Public to VBproject as it may be used in almost every module.
Public WSCombined As Worksheet
Public WSResult As Worksheet
'Worksheet names: VBPublic to project as it may be used in almost every module.
Public Const Combined As String = "Combined data"
Public Const Result As String = "Result"
'Array: Public to VBproject as it may be used in almost every module.
Public Arr() As Variant
Sub Main()
On Error GoTo ERRHANDLER
Dim Rng As Range
With ThisWorkbook
'error labels for passing to Erl, so that corresponding sheet names can then be selected for sheet objects.
10001: Set WSCombined = .Sheets(Combined)
10002: Set WSResult = .Sheets(Result)
10003: Set Rng = WSCombined.Rows(1).EntireRow
10004: Arr = Rng
End With
EXITSUB:
' cleanup
Set WSCombined = Nothing
Set WSResult = Nothing
Exit Sub
ERRHANDLER:
If ErrorHandling(Err, ThisWorkbook, Erl) Then
GoTo EXITSUB
Else
Resume
End If
End Sub
Function ErrorHandling(objError As Object, Optional WB As Workbook, Optional ERlCode As Long) As Boolean
With objError
Select Case .Number
Case Is = 9 'subscript out of range
Select Case ERlCode
Case Is = 10001 ' Worksheet: for Combined sheet
Call SheetExists(WB, Combined)
Case Is = 10002 ' Worksheet: for Result sheet
Call SheetExists(WB, Result)
Case Is = 10003 ' Array: Array not initialized
Call IsArrayAllocated(Arr)
Case Else
End Select
ErrorHandling = False ' resume again at same line, after sheet has been created.
Case Is = 91 ' Object variable or with variable not found
Call IsArrayAllocated(Arr)
Case Is = ""
Case Else
MsgBox objError.Number & " - " & objError.Description
ErrorHandling = True
End Select
End With
objError.Clear
On Error GoTo 0
End Function
Function SheetExists(WBook As Workbook, SHTName As String) As Worksheet
On Error GoTo ERRHANDLE
With WBook
Set SheetExists = .Sheets(SHTName)
End With
EXITFUNC:
Exit Function
ERRHANDLE:
With WBook
Dim Sh As Worksheet
Set SheetExists = .Sheets.Add
SheetExists.Name = SHTName
End With
Resume EXITFUNC
End Function
Function IsArrayAllocated(Arr As Variant) As Variant
'Courtesy: #Chip Pearson
' check if array is initialized, if not initialize it
On Error GoTo ERRHANDLE
IsArrayAllocated = (IsArray(Arr) And Not IsError(LBound(Arr, 1)) And LBound(Arr, 1) <= UBound(Arr, 1))
EXITFUNC:
Exit Function
ERRHANDLE:
ReDim Arr(0 To 0)
IsArrayAllocated = Arr
GoTo EXITFUNC
End Function
To tackle some errors, the other way i was thinking is to just have functions created which could have their own error handling code and rectify the error in place itself, instead of passing it to a global error handler of main proc.
e.g.
Sub Main()
On Error GoTo ERRHANDLER
Dim Rng As Range
With ThisWorkbook
set WSCombined = SheetExists(ThisWorkbook, Combined)
Set WSResult = SheetExists(ThisWorkbook, Result)
....
....
Function SheetExists(WBook As Workbook, SHTName As String) As Worksheet
On Error GoTo ERRHANDLE
With WBook
Set SheetExists = .Sheets(SHTName)
End With
EXITFUNC:
Exit Function
ERRHANDLE:
With WBook
Dim Sh As Worksheet
Set SheetExists = .Sheets.Add
SheetExists.Name = SHTName
End With
Resume EXITFUNC
End Function
Any help would be most appreciated.
One answer to your specific question is to use another global object to store the object that threw the error in:
Public LastErrorObject As Object
Sub Main()
With ThisWorkbook
Set LastErrorObject = ThisWorkbook
Set WSCombined = .Sheets(Combined)
End With
End Sub
However, this is incredibly cumbersome, because you need to keep track of it everywhere. Also, it still doesn't do much in the way of giving you the context for the error.
Your second idea is much better, and doesn't abuse the error handler as much because it both acknowleges that there may be an error and actively seeks to avoid errors instead of passively trying to deal with them. For example, instead of indexing into ActiveWorkbook.Worksheets() directly, you can do something like this to make sure you get a new sheet back:
Private Function GetOrCreateWorksheet(book As Workbook, name As String) As Worksheet
On Error GoTo ForceNew
Dim result As Worksheet
Set result = book.Worksheets(name)
ForceNew:
If Err.Number = 9 Then
Set result = book.Worksheets.Add()
result.name = name
ElseIf Err.Number <> 0 Then
Err.Raise Err.Number, Err.source, Err.Description
End If
Set GetOrCreateWorksheet = result
End Function
Note that the error handling is only checking for the one specific error that you'll get if the sheet doesn't exit (Subscript out of range).
BTW and off topic, your Select Case syntax is overly convoluted - you only need to specify the case and can leave out the Is = syntax. It is also much easier to read with another level of indentation:
Select Case ERlCode
Case 10001
'...
Case 10002
'...
Case Else
'...
End Select

Macro to loop through each worksheet and unfilter all tables

I wrote some very simple code that just loops through each sheet in a workbook, and then removes filtering (if activated) by using ActiveSheet.ShowAllData.
Here is the (updated) code:
Sub removeFilters()
'This macro removes any filtering in
'order to display all of the data but it does not remove the filter arrows
On Error GoTo Errorcatch
For i = 1 To ActiveWorkbook.Worksheets.Count
If ActiveSheet.Visible = True Then
ActiveSheet.ShowAllData
End If
Next i
Exit Sub
Errorcatch:
MsgBox Err.Description
End Sub
The code appears to work alright, but it ends with an error, and then a MsgBox displays. Here is a screenshot of the MsgBox:
The workbook has some hidden sheets, and I want to skip them entirely, which is why I added the If statement.
ShowAllData throws an error if autofilter is not activated, so:
Dim ws As Worksheet
On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
If ws.Visible Then ws.ShowAllData
Next ws
on error goto 0 'or to hell or whatever
If you are dealing with Tables:
Sub removeFilters()
Dim ws As Worksheet
Dim oList As ListObject
'This macro removes any Table filtering in
'order to display all of the data but it does not remove the filter arrows
For Each ws In ActiveWorkbook.Worksheets
For Each oList In ws.ListObjects
oList.AutoFilter.ShowAllData
Next oList
Next ws
End Sub
This works for me perfectly.
Sub resetFilter()
Dim xWs As Worksheet
For Each Wks In ThisWorkbook.Worksheets
On Error Resume Next
If Wks.AutoFilterMode Then
Wks.AutoFilter.ShowAllData
End If
Next Wks
End Sub

Runtime error "9" in VBA[excel] - Subscript out of range

I am currently working on a code that takes the date from the user, opens a calendar, sees if the month is present, and if it isn't, creates a worksheet with that month name.
The code looks like this where m_y is a string, and has values such as "January 2014" [the " signs included]:
Sub addmonth(m_y)
On Error Resume Next
CalendarWorkbook.Worksheets(m_y).Select
If Err.Number<>0 Then
'code to add sheet and format it
I tried putting it in a With/End With command, I have no Option Explicit in the code. Other methods mentioned in answers such as using the .Range() instead of the .Select; however I had no luck in succeeding.
Any help provided would be appreciated.
.Select in most cases is the main cause of runtime errors. I believe you have another workbook open. INTERESTING READ
Try this another way which doesn't use .Select
Option Explicit
Sub test()
addmonth ("""Feb2015""")
End Sub
Sub addmonth(m_y)
Dim calendarworkbook As Workbook
Dim ws As Worksheet
Set calendarworkbook = ThisWorkbook
On Error Resume Next
Set ws = calendarworkbook.Worksheets(m_y)
On Error GoTo 0
If ws Is Nothing Then calendarworkbook.Worksheets.Add.Name = m_y
End Sub
Note: OERN (On Error Resume Next) should be used judiciously. Ensure that it just curbs the message for only the part that you want and not for the rest. Else it is not good error handling :)
This worked for me
Sub test()
addmonth ("""Feb2015""")
End Sub
Sub addmonth(m_y)
Dim calendarworkbook As Workbook
Set calendarworkbook = ThisWorkbook
On Error Resume Next
calendarworkbook.Worksheets(m_y).Select
If Err.Number <> 0 Then
With calendarworkbook.Worksheets.Add
.Name = m_y
End With
End If
End Sub

Is it possible to check if the name of the sheets is around?

I was wondering if it is possible to check for a particular sheets for its availability. If it is around, it will continue on with the rest of the code. If not around then it will add in the sheet.
I have thought of it but it is giving me error. Do share some info if u know something! thanks!
sub macro1()
If sheets("Test") = False Then
Sheets.Add.Name = "Test"
End If
'Run my code
End Sub
Like this?
Sub Sample()
Dim ws As Worksheet
On Error Resume Next
Set ws = Sheets("Test")
On Error GoTo 0
If ws Is Nothing Then
Set ws = Sheets.Add
ws.Name = "Test"
End If
'~~> Run your code
End Sub
Another approach ... create a function that
- accepts a workbook object and the name of the sheet you're after and
- returns tru if the sheet is found in the workbook
Function SheetExists(oWorkbook As Workbook, sSheetname As String)
Dim oWs As Worksheet
For Each oWs In oWorkbook.Worksheets
If oWs.Name = sSheetname Then
SheetExists = True
Exit Function
End If
Next
End Function
Sub TestSheetExists()
If SheetExists(ActiveWorkbook, "Bob") Then
MsgBox "Found it"
Else
MsgBox "No joy"
End If
End Sub