Excel is crashing every time I run the below code.
I'm trying to unhide names. There are a lot of them. I tried to copy a sheet and it took me forever to get rid of the name conflict messages.
Is there a way to unhide only some names at a time so Excel doesn't crash?
Sub Show_Hidden_Defined_Names()
Dim xName As Variant
For Each xName In ActiveWorkbook.Names
xName.Visible = True
Next xName
End Sub
Some names (particularly those that start with "_") are defined based on certain newer functions being used in your workbook or things like print regions. See if avoiding those will help:
Sub Show_Hidden_Defined_Names()
Dim xName As Name
For Each xName In ThisWorkbook.Names
If Left$(xName.Name, 1) <> "_" Then xName.Visible = True
Next
End Sub
Also, as shown above, it's a good idea in most cases to use ThisWorkbook rather than ActiveWorkbook. The latter refers to whichever workbook has focus, the former, to the one that contains the VBA code. They may not always be the same.
Use this code to see which Name causes the crash
Sub Show_Hidden_Defined_Names()
On Error Resume Next
Dim s As String:s = "No errors"
Dim xName As Name
For Each xName In ActiveWorkbook.Names
xName.Visible = True
If Err.Number <> 0 Then
s = xName.Name
Exit For
End If
Next xName
MsgBox s
End Sub
Related
I am writing a VBA code where I need to find if sheet name given by user through inputbox is available or not in a workbook containing many sheets.
But if the sheet name is not available then the inputbox pops up again to enter the sheet name so it can search again.
I have written 1st part of the code which is working fine but I need help with the 2nd part(if the sheet name is not available). Let me know if this is possible in for loop or I have to use other loop?
Sub callbyinputbox()
Dim pendworkbook As Workbook
Dim sht As Worksheet
Dim entername As String
Set pendworkbook = Workbooks("pend_app_new.xlsx")
entername = InputBox("Enter name", "Search Sheet")
For Each sht In pendworkbook.Worksheets
If sht.Name = entername Then
pendworkbook.Sheets(entername).Activate
Exit Sub
End If
Next sht
MsgBox ("You entered " & entername & vbNewLine & "Sheet by this name is not available")
end sub
Here is your code:
entername = InputBox("Enter name", "Search Sheet")
For Each sht In pendworkbook.Worksheets
If sht.Name = enterDate Then
pendworkbook.Sheets(entername).Activate
Exit Sub
End If
Next sht
You store the response from the user in a variable: entername.
You then loop through all the sheets and check if the name matches a variable called enterDate.
Change this to entername and it will then have something to match against, and the If block will run.
Check out using Option Explicit - this would have highlighted this issue for you.
UPDATE:
This is probably breaking an unwritten rule somewhere, but a simple Do Until False loop, which will permanently run (until the Exit Sub condition is reached and breaks the loop) will keep asking until a valid sheetname is input.
Alternatively, you could use a For.. Next loop. That way, you could set a maximum number of prompts before giving up..
Note: I have made this comparison case insensitive - to give the user a better chance of inputting a correct sheet name.
Sub callbyinputbox()
Dim pendworkbook As Workbook
Dim sht As Worksheet
Dim entername As String
Set pendworkbook = Workbooks("pend_app_new.xlsx")
Do Until False
entername = InputBox("Enter name", "Search Sheet")
For Each sht In pendworkbook.Worksheets
If LCase(sht.Name) = LCase(entername) Then
pendworkbook.Sheets(entername).Activate
Exit Sub
End If
Next sht
MsgBox ("You entered " & entername & vbNewLine & "Sheet by this name is not available")
Loop
End Sub
All the while, I have attempted to correct your code and explain the reasoning. For that reason, I have tried to keep as much of your code as possible and just steer you toward your goal. If I was writing this from scratch, I would use the approach suggested by Ike.
To handle all usecases (no input given, existing sheetname given, non-existing sheetname given) - you can use this code:
Public Sub activateSheetByUserInput()
Dim pendworkbook As Workbook
Dim sht As Worksheet
Dim entername As String
Set pendworkbook = Workbooks("pend_app_new.xlsx")
retry:
entername = InputBox("Enter name", "Search Sheet")
If LenB(entername) = 0 Then
Exit Sub
ElseIf tryGetWorksheetByName(pendworkbook, entername, sht) = True Then
sht.Activate
Else
'give the user the option to cancel the process
If vbCancel = MsgBox("You entered " & entername & vbNewLine & "Sheet by this name is not available", vbCritical + vbRetryCancel) Then
Exit Sub
Else
GoTo retry
End If
End If
End Sub
'function returns true if worksheet was found - plus the ws itself
Private Function tryGetWorksheetByName(ByVal wb As Workbook, ByVal strName, ByRef sht As Worksheet) As Boolean
On Error Resume Next 'one of the rare cases where it is valid to use on error resume next
Set sht = wb.Worksheets(strName)
If Err = 0 Then tryGetWorksheetByName = True
On Error GoTo 0
End Function
Another way would be to supply a list of valid sheet names and ask them to select one.
Add a userform and place a listbox on it. I've left the default names, but would be better to name the controls to something relevant.
Add this code to the form:
Private Sub UserForm_Initialize()
Dim pendworkbook As Workbook
Set pendworkbook = Workbooks("pend_app_new.xlsx")
Dim shts() As Variant
ReDim shts(0 To 0, 0 To pendworkbook.Worksheets.Count - 1)
Dim x As Long
For x = 1 To pendworkbook.Worksheets.Count
shts(0, x - 1) = pendworkbook.Worksheets(x).Name
Next x
ListBox1.List = Application.WorksheetFunction.Transpose(shts)
End Sub
Private Sub ListBox1_Click()
MsgBox "You clicked " & ListBox1.Value
End Sub
hi can you help figure out how to copy worksheet if it existing, and if it is not will automatically create a new workbook then save as blank. please see my code below I try it in if the file is existing copy the file and if not create a new blank file.
Workbooks.Open path1
Sheets.Select
If Sheets("Draft") = "" Then
Set wb = Workbooks.Add
ActiveWorkbook.SaveAs saveFolder & "\D201\D201.xlsx", FileFormat:=51
ActiveWorkbook.Close
Else
Sheets("Draft").Copy
ActiveWorkbook.SaveAs saveFolder & "\D201\D201.xlsx", FileFormat:=51
Workbooks(file1).Close
ActiveWorkbook.Close
End If
and I've encountered an error it says Subscript out of range
Pretty sure you didn't try real hard there (given debugging the error thrown would have lead you to the obvious error). 😊
Here are two possible ways to test for the existence of sheet with a specific name:
Sub Temp()
''' Two possible ways to determine if a sheet with a specific name exists
''' Both assume you're looking for the sheet in the Active Book
''' There are other ways
''' Sledge hammer approach (very efficient)
Dim lgErr&
On Error Resume Next: Err.Clear
With Sheets("Draft"): End With: lgErr = Err
On Error GoTo 0
If lgErr <> 0 Then
' Sheets("Draft") does not exist in the active workbook
Else
' Sheets("Draft") does exist in the active workbook
End If
''' More subtle approach (just as effective and only marginally less efficient)
Dim in1%
For in1 = 1 To Sheets.Count
If Sheets(in1).Name = "Draft" Then Exit For
Next in1
If in1 > Sheets.Count Then
' Sheets("Draft") does not exist in the active workbook
Else
' Sheets("Draft") does exist in the active workbook
End If
End Sub
Notes:
The 1st approach if often used by people confident of their vba skills.
The risk is that a coding error between On Error Resume Next and On Error GoTo 0 could result in and invalid conclusion.
The 2nd approach does not have this same risk.
i usually use a function to test if a sheet exists in my workbook:
Function Feuille_Existe(ByVal Nom_Feuille As String) As Boolean
Dim Feuille As Excel.Worksheet
On Error GoTo Feuille_Absente_Error
Set Feuille = ActiveWorkbook.Worksheets(Nom_Feuille)
On Error GoTo 0
Feuille_Existe = True
Exit Function
Feuille_Absente_Error:
Feuille_Existe = False
End Function
Put this on top of your module and when you need it in your code :
If Feuille_Existe("XXX") Then
'do what you want'
End If
This question already has an answer here:
How do I get my code to apply to a file in which I only know part of the name
(1 answer)
Closed 3 years ago.
Sub movedata_tab_to_2excelFile()
Windows("1excelfileInstructions and macrostest.xlsm"). _
Activate
Sheets("Data").Select
Sheets("Data").Copy Before:=Workbooks( _
"2excel File4253.xlsx").Sheets(3)
Windows("Instructions_and_macros_Test1.xlsm").Activate
End Sub
I want to move the data tab in [1excelfileInstructions and macrostest.xlsm] to 2excel File4253.xlsx and I have the macro stored in Instructions_and_macros_Test1.xlsm.
My problem is the excel file name of 2excel File4253.xlsx keeps changing and I only know the partial name of it. Is there anyway to run my code in which it can ignore the numbers before and after the excel file name like adding asterisks/wild card to it example excel File
if your Excel files are open then you can try to do the following:
Sub foo()
Dim wbkCount As Long
For wbkCount = 1 To Workbooks.Count
If Workbooks(wbkCount).Name Like "*excel File*" Then
Debug.Print "This is the one!" & Workbooks(wbkCount).Name
'do something
End If
Next wbkCount
End Sub
Basically the idea is for VBA to loop through all your open Workbooks and find the one that matches the name excel File. Once it is found, the code will perform the relevant action (replace Debug.Print and 'do something lines with your Copy statement).
Edit - full code:
Sub movedata_tab_to_2excelFile()
Dim wbkCount As Long
Windows("1excelfileInstructions and macrostest.xlsm"). _
Activate
For wbkCount = 1 To Workbooks.Count
If Workbooks(wbkCount).Name Like "*excel File*" Then
Sheets("Data").Copy Before:=Workbooks( _
Workbooks(wbkCount).Name).Sheets(3)
End If
Next wbkCount
Windows("Instructions_and_macros_Test1.xlsm").Activate
End Sub
Try this: (Tested)
Sub movedata_tab_to_2excelFile()
fnd = Dir("C:\Users\mohit.bansal\Desktop\Test\" & "*excel File*.xlsm") 'Change the Folder Path
If fnd <> "" Then
Workbooks("1excelfileInstructions and macrostest.xlsm.xlsm").Worksheets("Data").Copy Before:=Workbooks(fnd).Sheets(3)
End If
End Sub
Also there is no Need for Activate and Select. You should always avoid those when working with VBA
Sub movedata_tab_to_2excelFile()
Dim s as string
Const path2SecondFile = "C:\" 'your path here, ending with \
s=dir(path2secondfile & "*File4253*.xlsx") 'or whatever wildcard pattern will find it
if s = "" then
msgbox "Can't Find File",vbokonly,"File Not Found"
else
dim found as boolean
dim wb as workbook
for each wb in workbooks
if wb.name = s then
'file already loaded
found=true
exit for
end if
next wb
if not found then
Workbooks.open(path2secondfile & s) 'if necessary
end if
with thisworkbook.Sheets("Data")
.Copy Before:=Workbooks(s).Sheets(3)
end with
End IF
End Sub
I have a CommandButton which opens a UserForm and create a copied Sheet with the name of the ComboBox Value.
This is My Code:
Private Sub CommandButton1_Click()
[UserForm1].Show ' Open UserForm
End Sub
Private Sub CommandButton2_Click()
Dim ws As Worksheet
ActiveWorkbook.Sheets("Sheet1").Visible = True ' Unhide Sheet
Sheets("Sheet1").Copy _
Before:=ActiveWorkbook.Sheets("Sheet1") ' Copy Sheet
Set ws = ActiveSheet
ws.Name = ComboBox1.Value ' Name Sheet
[UserForm1].Hide ' Close UserForm
ActiveWorkbook.Sheets("Sheet1").Visible = False ' Hide Sheet again
End sub
Now my problem is, if there are two machines with name "Machine Type 1" Excel gets an Error. So what do i have to change in my code, that the second sheet would named e.g. "Machine Type 1 (2)?
Thanks for your help.
you could try this
Private Sub CommandButton1_Click()
If IsSheetThere(ComboBox1.Value) Then 'if some sheet with chosen name already there
Sheets(ComboBox1.Value).Copy Before:=Sheets(10) ' copy the existing sheet
With ActiveSheet 'reference just copied sheet
.UsedRange.Clear 'clear its content
Sheets("Sheet1").UsedRange.Copy ActiveSheet.Range("A1") ' copy Sheet1 content and paste into it
End With
Else 'otherwise
Sheets("Sheet1").Copy Before:=Sheets(Sheets.Count) ' make a copy of "Sheet1" sheet
ActiveSheet.Name = ComboBox1.Value 'and rename it as per chosen name
End If
Me.Hide
End Sub
Function IsSheetThere(shtName As String) As Boolean
On Error Resume Next
IsSheetThere = Not Sheets(shtName) Is Nothing
End Function
the code line:
Sheets(ComboBox1.Value).Copy Before:=Sheets(10) ' copy the existing sheet
is the one that leaves Excel the burden of somehow "counting" the number of already existing sheets with the chosen name, and name the new one appropriately
You can use the following sub which calls the below function, just apply the same logic using .Copy
Sub create_new_sheet_with_name(name As String, wb As Workbook, aftersheet As Variant)
Dim i As Integer
i = 2
If sheet_name_exists(name, wb) Then
Do While sheet_name_exists(name & " (" & i & ")", wb)
i = i + 1
Loop
wb.Sheets.Add(after:=aftersheet).name = name & " (" & i & ")"
Else
wb.Sheets.Add(after:=aftersheet).name = name
End If
End Sub
Function sheet_name_exists(name As String, wb As Workbook) As Boolean
For Each sheet In wb.Worksheets
If sheet.name = name Then
sheet_name_exists = True
Exit Function
End If
Next sheet
sheet_name_exists = False
End Function
here's an example of how to use the sub:
Sub test()
create_new_sheet_with_name "hi", ThisWorkbook, ThisWorkbook.Sheets(1)
'this adds a new sheet named "hi" to thisworkbook after thisworkbook.sheets(1)
End Sub
Technically this isn't an answer to this question... but it's better because it will help you solve this and many other coding tasks on your own.
There is a simple way to create VBA code for most basic tasks.
If there's something Excel can do that you want to be able to do programmatically, just Record a Macro of yourself performing the action(s), and then look at the code that Excel generated.
I have a terrible memory, I can't remember commands I used yesterday. So it's not only quicker and less frustrating for others for me to figure it out myself, but the more often I do that, the quicker I'll learn (without asking others to do the thinking for me on a basic question).
I fact, I'm guess that the majority of veteran VBA coders learned at least partly by analyzing recorded macros. I know I did.
I have a "Save Inputs" macro in a tool I created which copies the main input sheet in order to save the values for later. The macro removes comments and other unnecessary parts of the original sheet. The tool itself has a bunch of range names, and these get copied along with the sheet. I am trying to delete all of them from the saved input sheet, but encountering an error.
Sub SaveProgramData()
Dim SheetCopy As Worksheet
Dim BookCopy As Workbook
Dim nm As Name
Set Analyzer = ThisWorkbook.Worksheets("Program Dashboard")
Analyzer.copy
Set SheetCopy = ActiveWorkbook.Worksheets(1) 'only way to address copy of a sheet created in new wkbk (i think)
Set BookCopy = SheetCopy.Parent
With SheetCopy
'remove comments, buttons, data validation, do some formatting, etc.
End With
For Each nm In BookCopy.Names
nm.Delete 'this results in a runtime error saying the name I entered is not valid
Next
End Sub
I'm confused because I'm not trying to enter a name, just delete them. I'm also open to another method of copying the sheet that won't keep the names.
EDIT: See comment below, the problem is that most of the names were assigned to ranges in the original workbook. Solved by adding additional condition to If statement:
For Each nm In BookCopy.Names
If InStr(1, nm.RefersTo, SheetCopy.Name) > 1 Or InStr(1, nm.RefersTo, ThisWorkbook.Name) > 1 Then 'check for names scoped to copied sheet, or original workbook
nm.Delete
End If
Next nm
You never initialize the Names variable, so it doesn't know what to loop through.
Try this instead:
Create the following Sub:
Sub RemoveNamesFromSheet()
Dim nm As Name
For Each nm In ActiveWorkbook.Names
If InStr(1, nm.RefersTo, ActiveSheet.Name) > 1 Then
nm.Delete
End If
Next nm
End Sub
Then simply replace your loop with RemoveNamesFromSheet
Hope that does the trick!
I think your last for loop should be for nm in BookCopy.Names
I got it working like this:
Sub RemoveNamesFromSheet()
Dim nm As Name
Application.Calculation = xlCalculateManual
For Each nm In ActiveWorkbook.Names
If InStr(nm, "C:\") > 1 Then
nm.Delete
End If
Next nm
Application.Calculation = xlCalculationAutomatic
Calculate
End Sub
It checks the name for the occurrence of "C:\" which is normally the name of another workbook, so all external references are removed. It assumes the workbooks referring to are closed.
You may also replace "C:\" with the filename that you just copied from. Temporarily disabling automatic recalculation speeds up the process dramatically.