I have the following issue:
I have a macro script for excel which is running through more then 300 excel workbooks,with several sheets.
The problem is that some of this sheets have faulty hyperlinks and each time I run the macro,the pop-up message informing me that the hyperlink found in the sheet is not working and I have to click each time , : ,,cancel'' . Is there a way (code) that I can write that will automatically ,,cancel'' the pop up question ,if it appears?
You should be able to bypass this by wrapping your code in:
Application.DisplayAlerts = False
-- your code --
Application.DisplayAlerts = True
Maybe the privacy options are related?
http://office.microsoft.com/en-001/excel-help/enable-or-disable-security-alerts-about-links-to-and-files-from-suspicious-web-sites-HA010039898.aspx
Let's say your hyperlinks were pointing to a worksheet's cells, and that worksheet may no longer exist, the best thing to do may be to simply remove those hyperlinks.
This is how you'd do this :
Sub RemoveDeadHyperlinks()
For Each hyperL In ActiveSheet.Hyperlinks
'Extract name of the sheet from the subaddress
toSheet = Left(hyperL.SubAddress, InStr(hyperL.SubAddress, "!") - 1)
If WorksheetExists(toSheet) Then
'Most likely a valid hyperlink!
Else
'Most likely a dead one!
hyperL.Delete
End If
Next
End Sub
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0
End Function
Related
I made a worksheet for the company I work for to help with pricing out custom designs. A few months ago I made a macro that can save the parts to a text file that can be pulled from at a later date if we wanted to quote out the same design. Everything was working perfectly, until one day I go to open it up and got the error message
We found a problem with some content in 'File.xlsm'. Do you want us to try
to recover as much as we can?
When I click yes, it then comes up with the worksheet the macro was on completely un-formatted and says it could only open the file by repairing or removing the following part
Repaired Part: /xl/worksheets/sheet3.xml part.
This is weird because the only xml code I use is just to create a drop-down menu when the saved design names are loaded. Nothing has changed since the final revision of the code other than the amount of designs that have been saved. The boxes I had as buttons tied to macros have been deleted and none of the code for this sheet works. What it shows when I view the code now is Sheet_Thumbnails
All other macros work, the other sheets are fully functional. When I try and run the code on this sheet I get
Run-time error '429':
ActiveX component can't create object
This has to be when compiling because I can't even debug where this is happening. The best answer I get when I look this error up is that I am not using the "New" keyword when calling a file or object from somewhere else. But I have looked through my code and don't see anywhere that applies. Luckily a co-worker saved a copy off our server to her computer so I have a backup, but when I open this and run the macros then save and re-open, the same crash happens.
Here is the code with xml:
Sub MakeList(ByRef r As Range, ByRef Config As String)
r.Clear
If Not Config = "" Then
r.Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Config
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End Sub
Can anyone help me? I am at a total loss for why this has happened and why it keeps happening. Is it the validation part? Why would it happen after working for months?
Thank you in advance.
EDIT 1
Exporting all of the code and creating a new workbook did not solve the problem.
Thanks to Profex, the problem has been found and is in the validation. Essentially one of my lists was too long. The formula used in validation is not supposed to be beyond 255 characters. Even though Excel doesn't give any warning on this, when I would create the drop down menus, although it would populate each item from the list, after saving closing and re-opening, apparently this would corrupt the coded sheet. So now the question lies with how to add values into a drop-down menu without clearing and re-initializing with a longer list. Should I post a new question for that?
In Excel, Cell Validation Lists have a 8191 character limit (which is way too long for a user to pick from anyway).
Anything over 254 characters will corrupt the file upon save/re-open.
Here is something similar to what I have done in the past to create Dynamic Validations lists:
It uses your MakeList() subroutine, and requires another GetList() function to get the validation list for the specified cell.
Since this code is in the Workbook module, I also added another function called IsSheetTheOneICareAboutWithValidations(). If you use the WorksSheet_SelectionChange Event from in a specific sheet module, this isn't required; but you would have to change the scope of m_ValidationCell and m_ValidationList to be Public.
This code is untested and goes in the ThisWorkbook module:
Option Explicit
Private m_ValidationCell As Excel.Range
Private m_ValidationList As String
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Not m_ValidationCell Is Nothing Then
m_ValidationList = m_ValidationCell.Validation.Value
m_ValidationCell.Validation.Delete
End If
End Sub
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
If m_ValidationList <> vbNullString Then
With m_ValidationCell.Validation
.Add Type:=xlValidateList, Formula1:=ValidationList
End With
m_ValidationList = vbNullString
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not m_ValidationCell Is Nothing Then
m_ValidationCell.Validation.Delete
Set m_ValidationCell = Nothing
End If
If IsSheetTheOneICareAboutWithValidations(Sh) Then
' Since we're changing the Validation each time there is a new Selection;
' It's the Active Cell that matters, not the Target range
' Add a validation list to any cell in column 4, after the header (in row 1).
If ActiveCell.Column = 4 And ActiveCell.Row > 1 Then
List = GetList(ActiveCell)
MakeList ActiveCell, List
' Should probably add this next line to you MakeList() function
Set m_ValidationCell = ActiveCell
End If
End If
End Sub
Private Function GetList(Target As Range) As String
GetList = vbNullString ' or whatever you want
End Function
Private Function IsSheetTheOneICareAboutWithValidations(Sh As Object) As Boolean
IsSheetTheOneICareAboutWithValidations = (Sh.Name = "Pricing")
End Function
Recovery
It looks like you just had a bad save. Sometimes it just corrupts the file and there isn't much you can do, other then hope you have a backup.
Right Click in the Folder > Properties > Previous Versions
If you don't have a backup, it might just help to move everything to a new file.
Create a New Workbook
Select All cells from your first sheet (click above the 1, left of the A)
Press Ctrl+C to Copy
Select All cells in your New Workbook/Sheet
Press Ctrl+V to Paste
Repeat for all Worksheets
On the VB side of things, you can just Drag the Forms/Modules/Classes from the Old file to the New One.
Issue
Did you know that all New Office documents are really just ZIP files...
Go ahead, rename the file to File.xlsm.zip
Inside the file you'll see a folder structure which should have .../xl/worksheets/sheet3.xml
This is what excel is complaining about! That file is either missing or wrong.
Code
I don't know how you're calling Makelist, so I can't verify that the range R that you are passing is valid.
Please remove the Select/Selection from your code. You don't need to select anything in the front end GUI of Excel to access/change the cells. Also you didn't check if R was Nothing.
Sub MakeList(ByRef r As Range, ByRef Config As String)
If Not r Is Nothing then
r.Clear
If Not Config = "" Then
With r.Validation
...
End With
End If
End If
End Sub
I think I need to try and make this question easier. So here goes;
I am creating a User form in Excel that will act as a data capture form.
In this form I have a Textbox called PolBX In this a is placed and at submission data in PolBX is copied into the "G" column using this code
Cells(emptyRow, 7).Value = PolBX.Value. This works great.
I discovered that there may be instances where the User may accidently use the same Unique Id number twice. so I am trying to find out how to code it that after the User has entered the Unique Id number it would check for that string (Consists of letters and numbers). if it finds the string already in the 7th column(G) it must say something like
"Policy number already Used, please try again"
I am thinking I will need to use the following subroutine
Private Sub PolBX_AfterUpdate()
End Sub
Can some please assist with creating this code...
Also can you please explain what you are doing as I started VBA about a week ago
You can add the following code to search for your policy number, and if nothing found then PolLookup = Nothing.
Option Explicit
Sub Test()
On Error GoTo ErrHandler
Dim ws As Worksheet, PolLookup As Range, LookupRng As Range
Set ws = ThisWorkbook.Worksheets(1)
'This is the range you want to search, it can be a long range
'or it can be a single cell.
Set LookupRng = ws.Range("A:A")
'Range.Find is looking for your value in the range you specified above
Set PolLookup = LookupRng.Find("YourLookupValue")
'PolLookup = Nothing if it didn't find a match, so we want to use
'If <NOT> Nothing, because this suggests .Find found your value
If Not PolLookup Is Nothing Then
Err.Raise vbObjectError + 0 'Whatever error you want to throw for finding a match
End If
'Exit before you reach the ErrHandler
Exit Sub
ErrHandler:
If Err.Number = vbObjectError + 0 Then
'Handle your error. Do you want to stop completely? Or have the
'User enter a new value?
End If
End Sub
Basically, after your user enters their value in your UserForm, just make a call to this Sub to do a quick lookup.
Playing around I discovered a Much easier way! I included a Button with he following code attached
Private Sub CommandButton8_Click()
Search = PolBX.Text
Set FoundCell = Worksheets("sheet1").Columns(7).Find(Search,LookIn:=xlValues, lookat:=xlWhole)
If FoundCell Is Nothing Then
MsgBox "No duplicates found"
Else
MsgBox "This policy has already been Assessed" & "Please assess a different case"
PolBX.Value = ""
End If
The code below is a function to move a worksheet in a workbook. It gets called from a userform that contains a listbox that lists the worksheets in the workbook. The input is an integer that gives the direction which to move the sheet. Left/right in workbook is up/down in the userform listbox, and the userform has up and down buttons that calls the function with different input (+1 for moving right and -2 for moving left).
This function sometimes gives the error Method 'Move' if object '_Worksheeet' failed, but not consistently. Mostly the error comes when moving a sheet a second time, so that I am not able to move a sheet more than once. Once the error occurs I am not able to move the sheet again. I can, however, select a different sheet and move this once before the same thing occurs.
If I implement a message box in the error handling, the behaviour changes. After closing the message box upon error, I can proceeed to move the same sheet again after an error. With a message box I can therefore move a sheet as many times as I want, but it only moves on every other button press. I guess the message box breaks code execution, which for some reason makes the function work again even one the same sheet that gave the error. I have tried replacing the message box with a delay or a selfclosing infobox but this does not give the same result.
To further complicate matters, sometimes when I open the userform application, the move buttons work perfectly without any error. I think this happens when the worksheet is already open before the application is opened.
It all seems very inconsistent, and beyond my knowledge. Any help or suggestions much appreciated.
Function FlyttMåling(Retning As Integer) As Boolean
Application.EnableEvents = False
Application.ScreenUpdating = False
'code to reference the correct workbook based on outside parameters
Dim wb As Workbook, ws As Worksheet
FlyttMåling = True
If Hovedvindu.LuftlydKnapp.Value = True Then
Set wb = ÅpneBok(1)
ElseIf Hovedvindu.TrinnlydKnapp.Value = True Then
Set wb = ÅpneBok(2)
End If
'sets variable to the index of sheet to be moved, chosen from list in userform
Dim nummer As Integer
Set ws = wb.Sheets(1)
If Hovedvindu.MålingerFrame.Liste.ListIndex < 0 Then
Exit Function
Else
Set ws = wb.Sheets(Hovedvindu.MålingerFrame.Liste.Value)
End If
nummer = ws.Index
'exit function if trying to move first sheet to the left or last sheet to the right
If (Retning = 1 And nummer = wb.Sheets.count) Or (Retning = -2 And nummer = 2) Then
Exit Function
End If
'code that moves worksheet
ws.Activate
On Error GoTo errHandler:
errResume:
ws.Move after:=wb.Sheets(nummer + Retning) 'THIS LINE CAUSES ERROR
On Error GoTo 0
Call oppdaterListe
'reselect the moved worksheet in the userform list
For i = 0 To Hovedvindu.MålingerFrame.Liste.ListCount - 1
If ws.Name = Hovedvindu.MålingerFrame.Liste.List(i) Then
Hovedvindu.MålingerFrame.Liste.Selected(i) = True
Exit For
End If
Next i
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Function
'error handling just sets the return to false to notify failure to move sheet
errHandler:
FlyttMåling = False
End Function
Found a workaround for this problmem. Changing the wb.move to a wb.copy, and then deleting the old sheet and renaming the copy to the name of the original sheet makes this code work as intended.
In an attempt to retrieve constants from each worksheet in some reporting workbooks I use, three years ago I wrote some code that gets included in each worksheet. Here's an example of the code:
Option Explicit
' Determine the type of worksheet
Private Const shtType As String = "CR"
Public Function GetShtType()
GetShtType = shtType
End Function
In other code that gets the values from the worksheets for processing, the following section of code is used, where 'wksToCheck' is the worksheet in question. This code is stored in a personal macro workbook, not in the workbook with the worksheet code:
' Get the sheet 'type' if it has one
On Error Resume Next
shtType = wksToCheck.GetShtType()
If Err.Number <> 0 Then
' We do not have a type
shtType = "Unknown"
Err.Clear
End If ' Err.Number...
On Error GoTo Error_BuildTemplateWbk
My problem is, I use the code above to process workbooks several times a week, and I have for the past three years. Now, I am trying to write some new code with the above block to process the report workbooks in a different way. However, when I run code with the above block now, I get a 'Method or Data Member Not Found' error on the '.GetShtType()' portion of the code. I cannot compile the code and of course, consequently, the code doesn't work. I have tried adding the worksheet code to a worksheet in the macro workbook to see if that would fix the problem. It hasn't. Does anyone have any ideas? I am running Excel 2013 on a Windows 7 PC. Any ideas?
Brian
Using late-binding, should avoid the error, Dim wksToCheck As Object, but you'll lose the intellisense.
If you're open to alternatives, you may have better luck simply using the CallByName function, or using worksheet's CustomProperties.
Using CallByName preserves backwards compatibility with your older workbooks if needed:
shtType = CallByName(wksToCheck, "GetShtType", VbMethod)
Or, using CustomProperties instead of a custom method, in your worksheets:
Private Sub Worksheet_Activate()
Const PropName$ = "ShtType"
Const ShtType$ = "CR"
On Error Resume Next
Me.CustomProperties(PropName) = ShtType$
If Err.Number = 13 Then
Me.CustomProperties.Add "PropName", ShtType
End If
End Sub
Then,
' Get the sheet 'type' if it has one
On Error Resume Next
shtType = wksToCheck.CustomProperties("ShtType")
If Err.Number = 13 Then
' We do not have a type
shtType = "Unknown"
Err.Clear
End If ' Err.Number...
On Error GoTo Error_BuildTemplateWbk
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.