Workbooks("The One Sheet.xlsx").Activate
MsgBox ActiveWorkbook.Name 'Returns "The One Sheet.xlsx"
Worksheets("One Sheet").Activate
MsgBox ActiveWorkbook.Name 'Returns "The One Sheet.xlsx"
RwCnt = Application.WorksheetFunction.CountA(Range("A:A"))
MsgBox ActiveWorkbook.Name 'Returns the sheet that contains the code
Does anyone know what could be calling the other workbook into focus?
Not sure what is calling up the other WB into focus. But it is best practice to explicitly define references to workbooks
Sub SheetCode()
Dim wbOne As Workbook
Dim RwCnt As Long
Set wbOne = Workbooks("The One Sheet")
wbOne.Activate
RwCnt = wbOne.ActiveSheet.Range("A" & wbOne.ActiveSheet.Rows.Count).End(xlUp).Row
MsgBox "The last row is " & RwCnt
End Sub
Hope that helps, Caleeco
Related
I am able to rename the activesheet using the following code but need to combine this with (first) duplicating the original sheet:
Sub CopySheet()
Dim strName As String
strName = InputBox("Budget2")
If strName = "" Then
Beep
Exit Sub
End If
ActiveSheet.Copy
ActiveSheet.Name = strName
End Sub
Per the documentation for the Worksheet.Copy method, using it without specifying either the Before or After argument will create a new Workbook, containing only that Worksheet.
So, to add a copy of the ActiveSheet after the ActiveSheet in the same Workbook, you can just change ActiveSheet.Copy to ActiveSheet.Copy After:=ActiveSheet
Make sure you check if the new sheet name already exists.
Make sure you keep track of where the copied sheet appears eg. after the source sheet SourceSheet.Copy After:=SourceSheet so you can pick up it's index which is 1 after the source sheet's: Set NewSheet = ThisWorkbook.Sheets(SourceSheet.Index + 1).
Finally make sure to catch errors on renaming if user entered not allowed characters or too long sheet names.
So you would end up with something like:
Option Explicit
Public Sub CopySheet()
Dim InputName As String
InputName = Application.InputBox("Budget2", Type:=2) '2 = text: https://learn.microsoft.com/en-us/office/vba/api/excel.application.inputbox#remarks
' user pressed cancel or entered nothing
If (VarType(InputName) = vbBoolean And InputName = False) Or InputName = vbNullString Then
Beep
Exit Sub
End If
' check if new sheet name already exists
On Error Resume Next
Dim TmpWs As Object
Set TmpWs = ThisWorkbook.Sheets(InputName)
On Error GoTo 0
If Not TmpWs Is Nothing Then
MsgBox "The Sheet '" & InputName & "' already exists", vbCritical
Exit Sub
End If
Dim SourceSheet As Object
Set SourceSheet = ActiveSheet
SourceSheet.Copy After:=SourceSheet
Dim NewSheet As Object
Set NewSheet = ThisWorkbook.Sheets(SourceSheet.Index + 1)
On Error GoTo ERR_RENAME
NewSheet.Name = "InputName"
On Error GoTo 0
Exit Sub
ERR_RENAME:
MsgBox "Sheet could not be renamed.", vbCritical
Err.Clear
End Sub
I'm making a budgeter sort of thing that helps people keep track of their money. I currently have a bunch of code that checks the current month and attempts to make a new sheet with the name (MM/YYYY) unless that sheet has already been made, if it has been made then nothing will happen.
Private Sub Worksheet_Change(ByVal Target As Range)
nowMonth = Month(Now)
nowYear = Year(Now)
sheetNameStr = nowMonth & "," & nowYear
sheetExists = False
For Each Sheet In Worksheets
If sheetNameStr = Sheet.Name Then
sheetExists = True
End If
Next Sheet
If sheetExists = False Then
Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = sheetNameStr
MsgBox ("New sheet named " & sheetNameStr & "was created")
End If
Sheets("Main").Activate
Worksheets("Main").Range("A5:D300").Copy Worksheets("sheetNameStr").Range("A1")
End Sub
The problem I am having is trying to copy and paste the history of my purchases/income and pasting it into the new sheet. I always get the
Run-time error '9': Subscript out of range
error.
If anyone could help that'd be great thanks!
Your line saying
Worksheets("Main").Range("A5:D300").Copy Worksheets("sheetNameStr").Range("A1")
is referring to a worksheet called "sheetNameStr", but you really want to refer to a sheet with the name contained in the variable sheetNameStr, i.e.
Worksheets("Main").Range("A5:D300").Copy Worksheets(sheetNameStr).Range("A1")
I have searched everywhere for an answer to this, but I can't find one. how do I check if there is more than 1 worksheet in Workbook.
To get the number of worksheets within an open workbook, something like:
Sub qwerty()
MsgBox "the number of worksheets in this workbook is: " & ThisWorkbook.Worksheets.Count
End Sub
This will exclude Charts, etc.If you have multiple workbooks open, then something like:
MsgBox "the number of worksheets in this workbook is: " & wb.Worksheets.Count
Where you would Set wb in a prior statement.
To run it from Personal.xlsb then Try this
Public Sub Count_Sheets()
Debug.Print "You Have " & Application.Sheets.count & " Sheets " ' Immediate Window
MsgBox "You Have " & Application.Sheets.count & " Sheets "
End Sub
Or use ActiveWorkbook.Sheets.count
This is what ended up working best for me. It incorporates multiple answers in here to do what it does.
Sub CountSheets()
Dim mainWB As Workbook
Dim mainWS As Worksheet
Set mainWB = ActiveWorkbook
Set mainWS = mainWB.Sheets(1)
If mainWB.Sheets.Count > 1 Then MsgBox "There is more than one worksheet in this Excel file."
End Sub
I am working on a macro, a part of which takes input from the user asking what he/she would like to rename the sheet. It works fine, but I run into a runtime error if the name provided by the user is already being used by a different sheet. I understand why the error occurs but am not sure as to how I could warn the user and handle the error.
My code is as follows:-
'Change sheet name
Dim sheetname As String
sheetname = InputBox(Prompt:="Enter Model Code (eg 2SV)", _
Title:="Model Code", Default:="Model Code here")
wsCopyTo.Name = sheetname
There are two ways to handle this.
First, trap the error, check if there was an error, and advise, then put the error trapping back to what it was
Dim sheetname As String
sheetname = InputBox(Prompt:="Enter Model Code (eg 2SV)", _
Title:="Model Code", Default:="Model Code here")
On Error Resume next
Err.Clear 'ensure previously unhandled errors do not give a false positive on err.number
wsCopyTo.Name = sheetname
If Err.Number = ?? then 'go back and ask for another name
On Error Goto 0
Second, check all the current sheet names, and see if there is a match
Dim sheetname As String
Dim sh 'as Sheet
sheetname = InputBox(Prompt:="Enter Model Code (eg 2SV)", _
Title:="Model Code", Default:="Model Code here")
for each sh in ActiveWorkbook.Sheets
If lower(sh.name)=lower(sheetname) then
'Goback and ask for another name
Next
wsCopyTo.Name = sheetname
Start by looping through the ones you have and compare their names with the one the user gave. If it matches, write a message saying that's used already. Exit the sub afterwards.
For i = 1 To ActiveWorkbook.Worksheets.Count
If Worksheets(i).Name = sheetname then
msgbox "This name is already in use!"
exit sub
End if
Next
I just wrote a post about using Excel's native Rename Sheet dialog to do this. That way you get error-checking for duplicates, illegal characters and names that are too long. Here's a routine that adds a sheet and calls the dialog. If the user doesn't rename it, then the new sheet is deleted:
Sub PromptForNewSheetWithName()
Dim DefaultSheetName As String
ActiveWorkbook.Worksheets.Add
DefaultSheetName = ActiveSheet.Name
Application.Dialogs(xlDialogWorkbookName).Show
If ActiveSheet.Name = DefaultSheetName Then
MsgBox "You didn't name the new sheet." & vbCrLf & _
"Processing cancelled", vbExclamation
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End If
End Sub
The whole post is at: http://yoursumbuddy.com/prompt-to-name-new-sheet/
The simplest way is to create a Worksheet variable and Set it to what user has input (you might want to Trim() as well to remove leading and trailing spaces).
If it's Nothing then name is safe to use. If Not Is Nothing then it already exists.
Dim oWS As Worksheet
On Error Resume Next
Set oWS = ThisWorkbook.Worksheets(sheetname)
If oWS Is Nothing Then
' Safe to use the name
Debug.Print """" & sheetname & """ is save to use."
Err.Clear
wsCopyTo.Name = sheetname
If Err.Number <> 0 Then
MsgBox "Cannot use """ & sheetname & """ as worksheet name."
Err.Clear
End If
Else
Debug.Print """" & sheetname & """ exists already! Cannot use."
' worksheet with same name already!
' handle it here
End If
Set oWS = Nothing
On Error GoTo 0
You could also put it into a loop until a unused sheetname is found.
I am trying to come up with code that will make copies of all the worksheets in a given workbook. Seems simple enough, right? A little Google searching and I cobbled together the following code:
Sub Commandbutton1_click()
Dim Cnt As Long
Dim i As Long
Dim Sht1 As String
Dim MyChoice As String
Dim MyFile As String
Dim CurrWorkBook As Excel.Workbook
Dim Month As String
'Instructional message box
MsgBox "When the 'Open' dialog appears, select the workbook containing the worksheets you want to split and then click Ok."
'Get file name
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Show
MyChoice = .SelectedItems(1)
End With
Application.ScreenUpdating = False
MyFile = Dir(MyChoice)
Set CurrWorkBook = Workbooks.Open(Filename:=MyFile)
CurrWorkBook.Activate
Cnt = Sheets.Count
InputMsg = "Enter the month of the EOM Budget Review:"
InputTitle = "Month"
Month = InputBox(InputMsg, InputTitle)
For i = 1 To Cnt Step 1
Sht1 = Sheets(i).Name
Sheets(Array(Sht1)).Copy
ActiveWorkbook.SaveAs Filename:=Sht1 & " - " & Month & " EOM Budget Review.xlsx", _
FileFormat:=51, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Next i
CurrWorkBook.Save
CurrWorkBook.Close
Application.ScreenUpdating = True
End Sub
It works perfectly...except when it doesn't. In some workbooks, it will copy every sheet with no difficulty. In some workbooks, it will copy some of the sheets, but throw the "Copy method of Sheets class failed" unless you have it skip certain sheets. I have not been able to figure out what the sheets it will not copy have in common. Is there some way I can improve this code? Are there certain features of worksheets that will cause this kind of code to fail inevitably?
Solved thanks to Alex P.'s comment above. I copied the following code from another forum:
Sub UnhideAll()
Dim WS As Worksheet
For Each WS In Worksheets
WS.Visible = True
Next
End Sub
Then I used Call UnhideAll right after Application.ScreenUpdating = False. I also used CurrWorkBook.Close savechanges:=False at the end so that the workbook being copied would not be saved and its hidden worksheets would go back to being hidden.