VBA Error 457 when using Collection to create a unique list - vba

BACKGROUND:
I am trying to identify how many unique time periods I have from a list of dates that have. Elsewhere, I have seen a method which utilizes collections and error trapping (right term? I mean "On Error Resume Next" in any case) to build the collection with unique values. I have even used this structure successfully in other code that I have written, but in my current circumstance, I am getting an "Error 457: This key is already associated with an element of this collection." Thinking I was using the collection incorrectly, I opened up some older code I wrote 6 months ago (on a different computer for a different company) which uses the same structure and was known to WORK. This older code broke on the same identical error, which it previously did not do. Here is the sample of my work-in-progress code:
Dim rng as range
Dim TimePeriod as Collection
Set TimePeriod = New Collection
For Each rng In Range("I2:I6")
On Error Resume Next
TimePeriod.Add rng.Value, CStr(rng.Value) 'This is where the code breaks
On Error GoTo 0
Next rng
QUESTION:
I'm wondering if there is a setting or a reference library that I am somehow missing that is causing both pieces of code to break, or how to determine that, since both codes are functionally identical, and the previously tested satisfactory code breaks like my work-in-progress. I expected the "On Error Resume Next" to force the loop to pass over the error. Any suggestions?
--Update--
Sample data in range("I2:I6") as follows:
1/21/15
1/21/15
1/21/15
1/23/15
1/27/15

Your code works properly on my Excel 2007, although I would rewrite it to enclose the entire loop within the on error resume next for efficiency.
I suspect you are seeing the errors now because of a mis-set macro option error break.
Check Tools/Options that you have not selected to Break on All Errors

Try getting rid of the On Error Goto 0 line. Take a look at this:
Difference between 'on error goto 0' and 'on error goto -1' -- VBA
It comes from Visual Basic 6, but works pretty much the same in VBA, it appears. Should work if you keep the On Error Resume Next line but eliminate the On Error Goto 0 line.

Related

Getting runtime error 1004, not sure what I'm doing wrong

So I'm a bit new to excel VBA, and I'm creating a macro to run on financial worksheets. I want to shift the values in the totals to the right place, as they are a column to the left of the actual data (these weren't created by a formula, they were generated by a different program and are fixed text). The shifting I managed to do just fine. The problem here is finding where the totals column is, as it varies between worksheets.
This is what I have so far.
For totalRow = 7 To 2000
With ws
If ws.Visible = True Then
If InStr(Range(totalRow, "A").Value, "Totals:") > 0 Then
Exit For
End If
End If
End With
Next totalRow
Yet for some reason, it's giving me an error when I try to run it. I know it's probably something simple I'm overlooking, because I cannot for the life of me figure out the problem. I've tried using a Do-Until loop, same issue. Is it a problem with the variables I'm using?
Several suggestions:
This is the basic problem:
Error 1004 "Application-defined or Object-defined error"
Look here for several potential issues/potential fixes:
VBA Runtime Error 1004 "Application-defined or Object-defined error" when Selecting Range
Use the VBA debugger and step through your macro a line at a time, until you find the specific object it's barfing on:
https://www.techonthenet.com/excel/macros/vba_debug2013.php
EDIT:
Having said that, I think Tim Williams's suggestion is probably spot-on:
You should always scope your Range/Cells calls with a worksheet
object, otherwise they will reference whatever happens to be the
Activesheet.
But PLEASE:
If at all possible, make the effort to learn troubleshooting tools available to you (like the debugger).
One other "useful tips" link I'd urge you to look at:
http://www.jlathamsite.com/Teach/VBA/WritingBulletProofCode.pdf

How to Use Error Handling to Skip Loop Iterations

I have a for loop where near the top I expect to throw an error trying to set a variable equal to a workbook. The error is returned because the workbook may or may not exist. The for loop loops over many workbooks and any number of them may or may not exist. the loop looks something like this
for i = 1 to x
'get ready for to open the workbook
set = myworkbook = workbooks.open("path\myworkbook" & date)
'do a bunch of stuff after I get the workbook
next i
this works all fine and dandy, but if the workbook doesn't exist, then I get an error. Now I have tried a handful of error handling techniques. Ideally what happens is that if the workbook isn't found, it skips right down to the bottom of the loop and just goes into the next i.
I have used goto statements to just jump to the bottom of the line, but that only works once and on the second pass through when the workbook doesn't exist, that throws an error. I have tried err.Clear after the the goto line so that the new error can be caught. I have tried goto -1 to clear the error but that doesn't work either. I have tried a variety of resume next statements but if the error doesn't occur because the workbooks are found, then that throws an error which I can't seem to handle. I check the error number before it starts the error handling routine wrapping the variable setting line to make sure that it shows 0 but it still throws the error.
There seem to be a lot of methods to solve this problem and I think I've tried them all. This isn't a unique problem I'm certain and I just need a push in the right direction. Thanks for any help you guys might provide.
Just so you don't think I haven't tried whatever solution you think of first, here are some other questions I've read:
For Loop, how to skip iterations
Difference between 'on error goto 0' and 'on error goto -1' -- VBA
On Error Goto 0 not resetting error trapping
Access VBA: Is it possible to reset error handling
Continue For loop
Error handling only works once
Why not something like this:
Public Sub SkipLoop()
On Error Resume Next
Dim i As Integer
Dim wb As Workbook
For i = 1 To 100
Err.Clear
Set wb = Workbooks.Open("some file")
If Err.Number = 0 Then
'do work on success
End If
Next
End Sub
No need to use error handling for something like this. Just use smart logic to your advantage:
Dim MyWorkbook as Workbook
for i = 1 to x
'get ready for to open the workbook
On Error Resume Next
set myworkbook = workbooks.open("path\myworkbook" & date)
On Error GoTo 0
If Not MyWorkbook Is Nothing Then
'do a bunch of stuff after I get the workbook
End if
next i
What this does is checks for 'Nothingness' of the object variable. If the object isnt set (wasnt found) the code within the If block wont run.

Run time error '1004' Unable to get the Match propertyof the WorksheetFunction class

In my macro, I have the following code :
i = Application.WorksheetFunction.Match(str_accrual, Range(Selection, Selection.End(xlToRight)), 0)
where 'str_accrual' is a string captured earlier to this line and the Range selected is in a single row say from "A1" to "BH1" and the result will be a number which is the position of that string in that range selected.
When I run the macro, I get the error:
Run time error '1004' Unable to get the Match propertyof the WorksheetFunction class
But when I run the macro line by line using (F8) key, I don't get this error but when I run the macro continuously I get the error. Again, if the abort the macro and run it again the error doesn't appear.
I tried several times. It seems that if there is no match, the expression will prompt this error
if you want to catch the error, use Application.Match instead
Then you can wrap it with isError
tons of posts on this error but no solution as far as I read the posts. It seems that for various worksheet functions to work, the worksheet must be active/visible. (That's at least my latest finding after my Match() was working randomly for spurious reasons.)
I hoped the mystery was solved, though activating worksheets for this kind of lookup action was a pain and costs a few CPU cycles.
So I played around with syntax variations and it turned out that the code started to work after I removed the underscore line breaks, regardless of the worksheet being displayed. <- well, for some reason I still had to activate the worksheet :-(
'does not work
'Set oCllHeader = ActiveWorkbook.Worksheets("Auswertung").Cells(oCllSpielID.Row, _
Application.Match( _
strValue, _
ActiveWorkbook.Worksheets("Auswertung").Range( _
oCllSpielID, _
ActiveWorkbook.Worksheets("Auswertung").Cells(oCllSpielID.Row, lastUsedCellInRow(oCllSpielID).Column)), _
0))
'does work (removed the line breaks with underscore for readibility) <- this syntax stopped working later, no way around activating the worksheet :-(
Set oCllHeader = ActiveWorkbook.Worksheets("Auswertung").Cells(oCllSpielID.Row, Application.Match(strValue, ActiveWorkbook.Worksheets("Auswertung").Range(oCllSpielID, ActiveWorkbook.Worksheets("Auswertung").Cells(oCllSpielID.Row, lastUsedCellInRow(oCllSpielID).Column)), 0))
In the end I am fretting running into more realizations of this mystery and spending lots of time again.
cheers
I was getting this error intermittently. Turns out, it happened when I had a different worksheet active.
As the docs for Range say,
When it's used without an object qualifier (an object to the left of the period), the Range property returns a range on the active sheet.
So, to fix the error you add a qualifier:
Sheet1.Range
I had this issue using a third-party generated xls file that the program was pulling from. When I changed the export from the third-party program to xls (data only) it resolved my issue. So for some of you, maybe there is an issue with pulling data from a cell that isn't just a clean value.
I apologize if my nomenclature isn't great, just a novice to this.
That is what you get if MATCH fails to find the value.
Try this instead:
If Not IsError(Application.Match(str_accrual, Range(Selection, Selection.End(xlToRight)), 0)) Then
i = Application.Match(str_accrual, Range(Selection, Selection.End(xlToRight)), 0)
Else
'do something if no match is found
End If
Update
Here is better code that does not rely on Selection except as a means of user-input for defining the range to be searched.
Sub Test()
Dim str_accrual As String
Dim rngToSearch As Range
str_accrual = InputBox("Search for?")
Set rngToSearch = Range(Selection, Selection.End(xlToRight))
If Not IsError(Application.Match(str_accrual, rngToSearch, 0)) Then
i = Application.Match(str_accrual, rngToSearch, 0)
MsgBox i
Else
MsgBox "no match is found in range(" & rngToSearch.Address & ")."
End If
End Sub
I used "If Not IsError" and the error kept showing. To prevent the error, add the following line as well:
On Local Error Resume Next
when nothing is found, Match returns data type Error, which is different from a number. You may want to try this.
dim result variant
result = Application.Match(....)
if Iserror(result)
then not found
else do your normal thing

VB Error in Excel

I am encountering an error in MS Excel when the following VB code is executed and the "Tracking Changes" feature is turned on:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
If IsEmpty(Target) Then
Target.Offset(0, 1).Value = Empty
Else
Target.Offset(0, 5).Value = Now()
End If
End If
End Sub
It seems that I can enter data into the first 2 rows just fine but once I start populating data in the 3rd row and onwards, I get a error stating "run-time error '1004' application-defined or object-defined error".
I get the error from row 2 onwards with this code and track changes turned on. The code however seems to do what it is supposed to do regardless of the error, so I would advise an On Error Resume Next to work around.
This doesn't address any underlying problem with the change tracking and your changes may not be being tracked.
Change Tracking forces the workbook to become Shared, which disables many features (e.g. you can't access VBA with Change Tracking enabled).
I'm not entirely sure why this error is being thrown, but a workaround to avoid seeing this message would be to Resume Next when an error occurs:
On Error Resume Next
Simply add this line of code about your first If block (If Target.Column = 1 Then). Please note that ideally you should want to discern the source of this issue and that this solution is a workaround, which might not be good practice.

Run-time error '-2147188160(80048240) DataType:=ppPasteEnhancedMetafile Error

Seems there is some bug. Can't resolve this problem, all code is running fine and I am able to see the AutoShape is getting copied from Excel file but it is not adding it to PowerPoint. Popping up an error Run-time error '-2147188160(80048240) View.Pastespecial : Invalid Request. The specified data type is unavailable
If Range("H" & i).Value = 1 And Range("B" & i).Value = "FRONT" Then
objPPT.Presentations(1).Slides(9).Select
objPPT.ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile
Your code will be faster and possibly more reliable if you don't rely on selecting anything:
With objPPT.Slides(9).Shapes
Set objShape = .PasteSpecial(ppPasteEnhancedMetafile)(1)
With objShape
' set coordinates and such here
End With
End With
As to why you're getting the error message, try stopping the code after you've put something on the clipbard. Then switch to PowerPoint, use Paste Special to see what paste options are available. If EMF isn't one of them, that's your problem ... you're not putting anything in EMF format on the clipboard.
I had a similar issue, but I found a different solution; it may be specific to what I was doing though.
I setup a program where I would:
(manual) Copy an entire webpage that was a report on several performance metrics
(manual) Pasted it in to excel
Run the program to extract the values I want and then clear contents of the sheet I pasted them on.
Eventually after many tests, it would fail with this same automation error when I tried to access the sheet:
Sheets("PDX Paste").Activate
I was able to activate every other sheet except that particular one, even using the index value instead of the direct name reference. After googling to no success I found out that the copy and paste from the website was also pasting invisible controls. When I found this out I had 1,300+ shapes when I only expected 1 (the button I use to trigger the program). It was actually only apparent when a glitch - presumably due to so much memory being used to store these controls - displayed for a few seconds.
I ran the following code independently and then appended it to the end of my program when I do the cleanup of the data. The code goes through the sheet and deletes any shape that isn't the same type as my button. It would have to be adapted if the shapes you want to delete are the same type as the shapes you want to keep. It also becomes simpler if you don't have any shapes to keep.
Dim wsh As Worksheet
Set wsh = ActiveSheet
Dim i As Integer
For i = wsh.Shapes.Count To 1 Step -1
If wsh.Shapes(i).Type <> wsh.Shapes("UpdateDataButton").Type Then
wsh.Shapes(i).Delete
End If
Next i
I'm not sure this would solve this problem, but hopefully this can help others and prevent loss of time figuring out what may be causing this relatively vague error message.