I use a For ... Next loop to insert pictures to an Excel worksheet. The name of the picture comes from column B. Sometimes, there is no corresponding picture on the hard disk. In such cases, Excel will throw an error message and stop running the codes. First, I tried "On Error Resume Next". This is not good because all the codes after the error occurs are executed. So, I tried the following code to try to avoid running codes when the picture is not found. This, however, only catches the first error. Excel still throws an error message ("unable to get the insert property of the pictures class") when the second time a picture is not found. All I want is if an error occurs, Excel would skip the rest of the code and go to the next case. How can this be done? Thanks for any help.
......
On Error GoTo gotoNext
For Each cell In rng
......
Set p = Workbooks(ActiveSheet.Parent.Name).Sheets(Sheet_to_Insert_Picture).Pictures.Insert(Path_Prefix & "\" & _
Replace(cell.Value, "/", "-") & ".jpg") 'when the picture is not found, Excel throws an error
......
gotoNext:
Err.Clear
Next
You can quickly check the existence of the image file with the Dir command. It will return the name of the file (hence a returned string length greater than zero) if it is found.
For Each cell In rng
if cbool(len(dir(Path_Prefix & "\" & Replace(cell.Value, "/", "-") & ".jpg"))) then
Set p = Workbooks(ActiveSheet.Parent.Name).Sheets(Sheet_to_Insert_Picture).Pictures.Insert(Path_Prefix & "\" & Replace(cell.Value, "/", "-") & ".jpg")
end if
next cell
Related
In VBA error handling is done by on error statement.
I want to temporarily change the error handling and then go back to the previous behavior afterward. How would it be possible to check the current error handling and store it in a variable (I couldn't find anything in the references)?
'set the error handling to s.th. "on error... "
'some code with the regular error handling
'change the error handling to "on error ..." (regardless of what it was before)
'some code with the new error handling
'change back to the previous error handling
'some code with the regular error handling
Background: I needed to do a is nothing check on a Variant array to exclude empty object indexes from being used, but is nothing applied to an array index that holds a value throws an exception, so I temporary wanted to change the error handling to on error resume next. Eventually is solved this using a different approach but I'm still wondering if I can determine the current error handling somehow during runtime Here's the question and answer to my original problem.
EDIT: I know I can check my previous code manually to find out what type of error handling has been used. However I want to avoid that (to save time).
I suppose as a workaround I could set an additional variable with the state which I can then check for the current state, although this will result in quite a bit of overhead. Something like this:
Dim errorHandling as String
errorHandling = "resumeNext"
on error resume next
'some code
'changing the error handling temp.
'some other code
'changing the error handling to it's previous state
if errorhandling = "resumeNext" then
On Error Resume Next
elseif errorhandling = "GoToErrorhandler" then
On Error GoTo errorhandler
End If
'Rest of the code
Read/Write to Array
Option Explicit
Sub ReadWriteArrayExample()
Dim myArray() As Variant: ReDim myArray(1 To 10)
Dim i As Long
Dim n As Long
' Fill the array.
For i = 1 To 10
n = Application.RandBetween(0, 1)
If n = 1 Then ' write a random number between 1 and 10 inclusive
myArray(i) = Application.RandBetween(1, 10)
'Else ' "n = 0"; leave the element as-is i.e. 'Empty';do nothing
End If
Next i
' Debug.Print the result.
Debug.Print "Position", "Value"
For i = 1 To 10
If Not IsEmpty(myArray(i)) Then ' write the index and the value
Debug.Print i, myArray(i)
'Else ' is empty; do nothing
End If
Next i
End Sub
Error Handling
Sub ErrorHandling()
Const ProcName As String = "ErrorHandling"
On Error GoTo ClearError ' enable error trapping
' Some code
On Error Resume Next ' defer error trapping
' Some tricky code
On Error GoTo ClearError ' re-enable error trapping
' Some Code
ProcExit:
Exit Sub
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Sub
I can't find where the error is. A similar code to pull dynamic file name worked in another tab.
Sub MonthlyBCRCPL()
Dim filePath As String
Dim CardsRCPLWb As Workbook
Set CardsRCPLWb = ActiveWorkbook
filePath = CardsRCPLWb.Sheets("BCRCPL").Range("A1").Value
'Optimize Code
Call OptimizeCode_Begin
Const FlashFolder As String = "\\apacdfs\SG\GCGR\GROUPS\ASEAN\Dashboard\Cards\Flash\"
Flashname = Format(CardsRCPLWb.Sheets("ASEAN - CARDS, RCPL").Range("C2").Value, "YYYYMMDD")
Flashname = "ASEAN SD Regional Dashboard - " & Flashname & ".xlsx"
Flashpath = FlashFolder & Flashname
Dim FlashWb As Workbook
Set FlashWb = Workbooks.Open(Flashpath)
If FlashWb Is Nothing Then MsgBox "SD Flash File does not exist": Exit Sub
Consider handling the error in the subroutine and have it raise a message. Then, properly continues/skips/exits rest of code even releasing objects from memory caught during the exception. This is a best practice in VBA (and generally in programming).
I suspect the path cannot be found which looks to be a network UNC, file naming is not valid such as use of special characters, or workbook does not exist when trying to open:
Sub MonthlyBCRCPL()
On Error Goto ErrHandle:
...code...
ExitSubBlock:
Set CardsRCPLWb = Nothing
Set FlashWb = Nothing
Exit Sub
ErrHandle:
Msgbox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
Goto ExitSubBlock
' Resume Next
End Sub
I have a macro that changed a tab name based on cell value (A4) which contains a formula to give the sheet a unique name, but I wanted to see if it was possible to create special case handling occurrences when there's a duplicate. So here's the code:
Sub RenameFromA4()
Dim Msg As String, i As Integer
For i = 5 To Sheets.Count
If Sheets(i).Range("A4").Value = "" Then
Msg = "Sheet " & i & "(" & Sheets(i).Name & ") has no value in A4. Fix sheet, then rerun."
MsgBox Msg, vbExclamation
Exit Sub
Else
On Error GoTo ErrSheetName
Sheets(i).Name = Sheets(i).Range("A4").Value
On Error GoTo 0
End If
Next i
Exit Sub
ErrSheetName: Msg = "Sheet " & i & "(" & Sheets(i).Name & ") could not be renamed. Check if name already used."
MsgBox Msg, vbExclamation
End Sub
The trouble I run into is sometimes duplicates can arise and error out my whole macro where it comes to a complete halt. So I want to add a sequence that when the macro encounters a duplicate add the following formula in cell B3: ="IF(AND(C4="",D4="",D3="",C3=""),TRIM((MID(A2,FIND(":",A2)+2,20))),"")&IF(IFERROR(FIND("West",A2),0)>0," W","")&" "&TRIM(RIGHT(SUBSTITUTE(A2," ",REPT(" ",255)),255))"
and pick from the error or just go back to rerunning the macro.
Any insight on how I can't structure this will be helpful.
You can explicitly check for the existence of a sheet named the same as the value in B4 by using a function like what is described here: Test or check if sheet exists. Then, you can insert something like the following between your On Error... and Sheets(i).Name...:
On Error GoTo ErrSheetName
If SheetExists(Sheets(i).Range("A4").Value) Then
Sheets(i).Range("B3").Formula = "=IF(AND(C4="",D4="",D3="",C3=""),TRIM((MID(A2,FIND(": ",A2)+2,20))),"")&IF(IFERROR(FIND("West ",A2),0)>0,"W ","")&""&TRIM(RIGHT(SUBSTITUTE(A2,"",REPT("",255)),255))"
End If
Sheets(i).Name = Sheets(i).Range("A4").Value
The following macro I am trying to use to move files in one location to another from an excel spreadsheet. The copy and pastes are used to copy the formula driven "source location" and "destination location" to new columns, to be used in the macro.
I keep getting the error? What is not right right with my approach?
Sub Combine()
Paste_Values
Paste_Values_Two
Copy_Files
End Sub
Sub Paste_Values()
Range("C2:C1000").Copy
Range("E2").PasteSpecial (xlPasteValues)
End Sub
Sub Paste_Values_Two()
Range("D2:D1000").Copy
Range("F2").PasteSpecial (xlPasteValues)
End Sub
Sub Copy_Files()
On Error GoTo ErrorHandler
Dim cell As Range
For Each cell In Range("E2", Range("E" & Rows.Count).End(xlUp))
FileCopy Source:=cell.Value, Destination:=cell.Offset(, 1).Value
Next cell
Exit Sub
ErrorHandler:
MsgBox "NOT WORKING"
End Sub
Many thanks
Since you do not provide any information at the error handling you do not know what exactly happens. However the only function which seems to be able to give an error is FileCopy:
If you try to use the FileCopy statement on a currently open file, an error occurs.
To show the error you can:
Disable the error handling (On Error GoTo ErrorHandler). This gave me the error: "Run-time error '53': File not found", but is not really user friendly since it stops the script.
You probably want something more informative, and handle this situation (by giving a message, and continuing to the following item). A more informative error message can be:
Msg = "Error # " & Str(Err.Number) & ": " & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
You might want to change the error handling to:
ErrorHandler:
If Err.Number <> 0 Then
Msg = "Error # " & Str(Err.Number) & ": " & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
End If
Resume Next
With Resume Next the For Each loop is continued.
Edit 1: If you get the error, are you sure that your files exist? You mentioned in your comments you have files like: Z:\1. Pro\XYZ\08_Decision_Tracker\5. M\1006\Mel.docx, are you completely sure the path is correct, do all the (sub)directories exist? And do you have write permission to Z:?
I'm trying to retrieve the sheet reference location from a hyperlink that's in a cell
The following doesn't seem to work as test doesn't return anything, even though G8 points to Sheet: KO in Cell A19
test = Range("G8").Hyperlinks(3).Address
Now if I run the following:
For Each hl In Sheets("LIST").Hyperlinks
MsgBox "Range " & hl.Range.Address & " addr " & _
hl.Address & " text " & hl.TextToDisplay
Next hl
It cycles through and finds the correct address but I can't seem to work out how to detect the sheet it's pointing. Also the loop is a bit of a mess because it errors out once it has found the first and only hyperlink in this situation. And it's not always specific for G8. I guess I could just throw an if statement in and exit the for loop early.
Regardless of that, I can't find anywhere in stackoverflow, google, microsofts "hyperlinks" docs a way to get the sheet name.
See below sample illustration:
SubAddress is what you want:
Sub Test()
Dim hl As Hyperlink, r As Range
Set hl = ActiveSheet.Hyperlinks(1)
Set r = Application.Evaluate(hl.SubAddress)
Debug.Print "Sheet: '" & r.Parent.Name & "'", "Range:" & r.Address()
End Sub