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
Related
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
I am trying to switch between a template (hard coded) and a dynamic report which changes name weekly (ThisWorkbook). I am struggling with calling the variable x to bring focus to the workbook. I am copying the template formulas and pasting them into the dynamic report.
Sub wkbk()
Dim x As Excel.Workbook
Set x = ThisWorkbook
Dim pth As String
pth = x.FullName
Windows(pth).Activate
End Sub
Here is the VBA code I am using:
Windows("BBU_CMD_TEMPLATE.xlsx").Activate
Cells.Select
Selection.Copy
Windows(pth).Activate
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Why not just use ThisWorkbook.Activate? There's generally no need to assign a variable to represent a built-in like ThisWorkbook so the rest of those variables are unnecessary unless you're using them elsewhere in that procedure (from the snippet provided, you aren't, so you don't need them).
Sub wkbk()
ThisWorkbook.Activate
End Sub
However, what's the point of wkbk procedure? If solely to activate the workbook, that's not needed either and there are plenty of reasons to avoid Activate.
Sub CopySheetFromTemplateToThisWorkbook()
Dim tmplt As Workbook
On Error Resume Next
Set tmplt = Workbooks("BBU_CMD_TEMPLATE.xlsx")
If tmplt Is Nothing Then
MsgBox "Template file needs to be open..."
Exit Sub
End If
On Error GoTo 0
With ThisWorkbook
tmplt.ActiveSheet.Copy After:=.Sheets(.Sheets.Count)
End With
End Sub
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
This code makes Excel non-responsive. Anyone know why that might be?
Sub delblank()
On Error Resume Next
ActiveSheet.UsedRange.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
If Err Then
MsgBox "No blank cells"
End If
End Sub
The problem is that UsedRange won't accept Range("A:A") as a property because the used range in your sheet does not contain an entire column from top to bottom of the Excel sheet, i.e. from row 1 to row 1048756.
What you want instead is to refer to the first column of UsedRange: replace Range("A:A") by Columns(1) like this:
ActiveSheet.UsedRange.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Now it works.
When you have a long chain of methods and properties giving you trouble like that, it's easier to break it down into its constituents in order to find the source of the error. That's what I did:
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim sh As Worksheet
Set sh = ActiveSheet
Set r1 = sh.UsedRange
Set r2 = r1.Range("A:A") ' Aha, error occurs here! Wow, that was easy to find.
Set r3 = r1.SpecialCells(xlCellTypeBlanks)
r3.EntireRow.Delete
When the error is gone, it's fine to put the chain back together again to get rid of the clutter.
Also don't use On Error Resume Next unless you're absolutely certain that this is what you want, because it will just swallow errors and not tell you where they came from.
Try something like this:
Public Sub Tester()
On Error Resume Next
Columns(1).SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0
End Sub
Try below code
Sub delblank()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim rng As Range
On Error Resume Next
Set rng = ActiveSheet.UsedRange.Range("A:A").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "No cells found"
Else
rng.EntireRow.Delete
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
I am trying to write a value to the "A1" cell, but am getting the following error:
Application-defined or object-defined error '1004'
I have tried many solutions on the net, but none are working. I am using excel 2007 and the file extensiton is .xlsm.
My code is as follows:
Sub varchanger()
On Error GoTo Whoa
Dim TxtRng As Range
Worksheets("Game").Activate
ActiveSheet.Unprotect
Set TxtRng = ActiveWorkbook.Sheets("Game").Cells(1, 1)
TxtRng.Value = "SubTotal"
'Worksheets("Game").Range("A1") = "Asdf"
LetsContinue:
Exit Sub
Whoa:
MsgBox Err.number
Resume LetsContinue
End Sub
Edit: After I get error if I click the caution icon and then select show calculation steps its working properly
I think you may be getting tripped up on the sheet protection. I streamlined your code a little and am explicitly setting references to the workbook and worksheet objects. In your example, you explicitly refer to the workbook and sheet when you're setting the TxtRng object, but not when you unprotect the sheet.
Try this:
Sub varchanger()
Dim wb As Workbook
Dim ws As Worksheet
Dim TxtRng As Range
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")
'or ws.Unprotect Password:="yourpass"
ws.Unprotect
Set TxtRng = ws.Range("A1")
TxtRng.Value = "SubTotal"
'http://stackoverflow.com/questions/8253776/worksheet-protection-set-using-ws-protect-but-doesnt-unprotect-using-the-menu
' or ws.Protect Password:="yourpass"
ws.Protect
End Sub
If I run the sub with ws.Unprotect commented out, I get a run-time error 1004. (Assuming I've protected the sheet and have the range locked.) Uncommenting the line allows the code to run fine.
NOTES:
I'm re-setting sheet protection after writing to the range. I'm assuming you want to do this if you had the sheet protected in the first place. If you are re-setting protection later after further processing, you'll need to remove that line.
I removed the error handler. The Excel error message gives you a lot more detail than Err.number. You can put it back in once you get your code working and display whatever you want. Obviously you can use Err.Description as well.
The Cells(1, 1) notation can cause a huge amount of grief. Be careful using it. Range("A1") is a lot easier for humans to parse and tends to prevent forehead-slapping mistakes.
I've had a few cranberry-vodkas tonight so I might be missing something...Is setting the range necessary? Why not use:
Activeworkbook.Sheets("Game").Range("A1").value = "Subtotal"
Does this fail as well?
Looks like you tried something similar:
'Worksheets("Game").Range("A1") = "Asdf"
However, Worksheets is a collection, so you can't reference "Game". I think you need to use the Sheets object instead.
replace
Range("A1") = "Asdf"
with
Range("A1").value = "Asdf"
try this instead
Set TxtRng = ActiveWorkbook.Sheets("Game").Range("A1")
ADDITION
Maybe the file is corrupt - this has happened to me several times before and the only solution is to copy everything out into a new file.
Please can you try the following:
Save a new xlsm file and call it "MyFullyQualified.xlsm"
Add a sheet with no protection and call it "mySheet"
Add a module to the workbook and add the following procedure
Does this run?
Sub varchanger()
With Excel.Application
.ScreenUpdating = True
.Calculation = Excel.xlCalculationAutomatic
.EnableEvents = True
End With
On Error GoTo Whoa:
Dim myBook As Excel.Workbook
Dim mySheet As Excel.Worksheet
Dim Rng As Excel.Range
Set myBook = Excel.Workbooks("MyFullyQualified.xlsm")
Set mySheet = myBook.Worksheets("mySheet")
Set Rng = mySheet.Range("A1")
'ActiveSheet.Unprotect
Rng.Value = "SubTotal"
Excel.Workbooks("MyFullyQualified.xlsm").Worksheets("mySheet").Range("A1").Value = "Asdf"
LetsContinue:
Exit Sub
Whoa:
MsgBox Err.Number
GoTo LetsContinue
End Sub