I would have a problem in creating an array, which contains a number of data, which then will be merged into one file. During reading the info from the files, then having them put into the another merged file, the loop in which it is situated it find a 2042 error. I found in Add Watch that it wants to give back #N/A as the function in the original file does not returns anything. How can I avoid my macro stopping? I have found ways to skip this record, but I cannot insert it into my current loop because of insufficient experience in handling these. It stops at here "If aOutput(1, outputCol) = aDataFromPivotFiltered(1, filteredCol) Then" See below a small bit of the macro.
For outputCol = 1 To UBound(aOutput, 2)
For filteredCol = 1 To UBound(aDataFromPivotFiltered, 2)
If aOutput(1, outputCol) = aDataFromPivotFiltered(1, filteredCol) Then
For filteredRow = 2 To UBound(aDataFromPivotFiltered, 1)
aOutput(filteredRow, outputCol) = aDataFromPivotFiltered(filteredRow, filteredCol)
Next filteredRow
Exit For
End If
Next filteredCol
Next outputCol
I have found the below, which would be ok, but it is applied another macro.
Sub Test()
Dim varIn As Variant
[a1].FormulaR1C1 = "=NA()"
If IsError([a1].Value2) Then
varIn = "skip record"
Else
varIn = [a1].Value2
End If
End Sub
Is there anyone who could help me with this? It keeps causing headaches not matter how many article I am reading in this topic. Cannot figure out.
Test for errors first, like below:
If Not IsError(aDataFromPivotFiltered(1, filteredCol) And Not IsError(aOutput(1, outputCol)) Then
If aOutput(1, outputCol) = aDataFromPivotFiltered(1, filteredCol) Then
For filteredRow = 2 To UBound(aDataFromPivotFiltered, 1)
aOutput(filteredRow, outputCol) = aDataFromPivotFiltered(filteredRow, filteredCol)
Next filteredRow
Exit For
End If
End If
This way, any formula errors that are passed into the array will be skipped.
Related
I am writing code to create a template. This code populates a tab named "fullDistribution" from user-input on different tabs in the same wb. I have a working section of code that I wrote in a separate module (for testing) away from my master module. The code runs properly and executes completely when it is separate. When I pasted this section of code into my master module and ran it, I began receiving "Run-time error 91: object variable or with block variable not set" at the start of the newly-pasted code. I am not using any with blocks, and all of my variables are set. I made no changes in my code when I transferred it to my master module, and I carried over the new variables I created.
This is the selection of code that I wrote in a separate module:
Worksheets("bls2016").Activate
tcount = WorksheetFunction.CountA(Worksheets("detailedEntity").Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row))
acount = WorksheetFunction.CountA(Worksheets("detailedEntity").Range("K2:K7"))
Application.ScreenUpdating = False
Dim h As Integer
Dim f As Integer
Dim blstate As Range
Dim bl As Range
Dim state As Range
Dim deat As Range
Dim agje As Range
Dim e As Integer
Dim r As Integer
Dim ii As Integer
Set blstate = Worksheets("bls2016").Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)
Set state = Worksheets("detailedEntity").Range("Q1")
Set deat = Worksheets("detailedEntity").Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)
Set agje = Worksheets("detailedEntity").Range("L2:M" & Cells(Rows.Count, "M").End(xlUp).Row)
h = Activecolumn
f = Activerow
r = 2
x = 120
For e = 1 To (acount * acount)
blstate.Find(state).Select
For ii = 1 To x
'ccnt = acst.Offset(0, 1)
ccgv = ActiveCell.Offset(0, 2)
acem = ActiveCell.Offset(0, 5)
Do While True
vl1 = Application.IfNa(Application.VLookup(Worksheets("fullDistribution").Cells(r, 2), deat, 1, False), 0)
If vl1 = 0 Then
Worksheets("fullDistribution").Cells(r, 4) = 0
Else:
vl2 = Application.IfNa(Application.VLookup(Worksheets("fullDistribution").Cells(r, 1), agje, 2, False), 0)
If ActiveCell.Offset(0, 1).Value = "Unknown Or Undefined" Then
Exit Do
Else:
If vl2 = ccgv Then
Worksheets("fullDistribution").Cells(r, 4) = acem
ElseIf vl2 <> ccgv Then
Worksheets("fullDistribution").Cells(r, 4) = ActiveCell.Offset(x + 1, 5)
Else:
End If
End If
End If
Exit Do
Loop
ActiveCell.Offset(f + 1, h).Select
r = r + 1
Next ii
Next e
The error triggers at the line "blstate.find(state).select" which tells excel to look in a dynamic range that contains the names of states and select the first instance of the state to use as the Activecell. Again, this works when it's run outside of the main module.
I believe this has something to do with a reference area. When this runs alone and finishes, I have to have a specific worksheet activated for it to run properly. If my excel workbook is open to a different tab, it will not run. My main module too only executes properly if it is run on a specific worksheet/tab.
If need be, I can edit my post and provide my whole master code.
It may be a problem of not fully referencing sheets, eg amend your blstate line to
with Worksheets("bls2016")
Set blstate = .Range("D2:D" & .Cells(.Rows.Count, "D").End(xlUp).Row)
end with
Then it might find the value and not error. You should look up how to use the Find method as your way is destined to cause you headaches.
blstate.Find(state).Select
Your code assumes that .Find finds what it's looking for. When Find doesn't find what it's looking for, the function returns Nothing, which is essentially a null object reference - and you can't make member calls on Nothing without getting run-time error 91.
Split it up:
Dim result As Range
Set result = blstate.Find(state)
If Not result Is Nothing Then
result.Select 'questionable anyway, but that's another issue
Else
MsgBox "Value '" & state & "' was not found in " & blstate.Address(External:=True) & "."
Exit Sub
End If
As for why it's not finding what you're looking for, Tim Williams already answered that:
Find recalls all settings used in the last call (even if you use the GUI to perform the Find), so make sure you specify the settings you want when you call it via VBA. If you don't do that, it may not work as you expect.... – Tim Williams 42 mins ago
My issue was very much related to incorrect referencing, however, I was able to resolve this issue by keeping the specific piece of code I was testing in a separate sub, and calling it from my main code, 'full distribution'.
Call test
'test' is the name of the sub with the tested code. This is a temporary fix to the solution, and if anyone struggles with referencing, try this.
I have read about Application.WorksheetFunction.Sum but I was wondering if there is a specific method or property of the Range-object that does the job. I have looked into Range's members but I didn't find anything.
Is there a way to add without the use of a worksheet function? And without having to loop through each cell. Something like:
Sub test()
Range("A1") = 1
Range("A2") = 0
Range("A3") = 2
Range("A4") = Range("A1:A3").Add
MsgBox Range("A4")
End Sub
With output 3.
go on then, a 4th way :o)
evaluate(join(application.transpose(range("a1:a5").Value),"+"))
In general, there is a third way, which you did not mention:
Application.Sum
It is a bit different than WorksheetFunction.Sum, in the fact that it is a bit more discrete - it does not throw errors with a MsgBox, even when it should.
Something like this will have only 2 errors thrown with MsgBox and you will get 2 errors in the immediate window:
Option Explicit
Public Sub WaysOfSumming()
'This is Div/0 Error:
Range("A1").Formula = "=5/0"
Debug.Print Excel.WorksheetFunction.Sum(Range("A1"), 3, 5)
Debug.Print Application.Sum(Range("A1"), 3, 5)
Debug.Print Excel.WorksheetFunction.Sum(Range("A1"), 3, 5)
Debug.Print Application.Sum(Range("A1"), 3, 5)
End Sub
I have a problem I can't seem to wrap my head around. I'm trying to populate a UserForm using Shapes (Images) from a Word-Document. I use this code to do so:
iShapeCount = wrdDoc.Shapes.Count
i = 0
If iShapeCount > 0 Then
ReDim oPic(iShapeCount - 1) As IPictureDisp
For Each wrdShape In wrdDoc.Shapes
With wrdShape
wrdDoc.Activate
.Select
wrdAppMain.ActiveDocument.ActiveWindow.Selection.Copy
Set oPic(i) = PastePicture(lPicType)
End With
i = i + 1
Next wrdShape
End If
With oPic being a one-dimentional Array of Pictures and PastePicture being the Subroutine to get the copied Image off of the Clipboard and into the Array as an Image-File.
So far so good.
This works exactly like it should, but as soon as there are more than two Shapes (Images) present in the Word-Document, the Copy-Command copies the first two like a charm, but all other ones (although correctly selected) will not be copied with the Copy-Command copying literally NOTHING.
Another funny thing: If I leave out the wrdAppMain.ActiveDocument.ActiveWindow.Selection.Copy-thingy and manually Ctrl-C the Shape selected by the Programm as it goes through the loop, it works no matter how many Shapes there are in the Word-Document.
So you see: I'm at the end of my rope here. Please help :)
Thank you in advance!
Why don't you just give the shape to the oPic-Array?
iShapeCount = wrdDoc.Shapes.Count
If iShapeCount > 0 Then
ReDim oPic(iShapeCount - 1) As IPictureDisp
For i = 0 to (iShapeCount -1)
For Each wrdShape In wrdDoc.Shapes
oPic(i) = wrdShape
Next wrdShape
Next i
End If
oPic would be declared as Variant.
In my VBA project I have the occasional MsgBox pop up to notify the user something has 'Completed' or 'Updated' after a subroutine has run.
It seems to run okay without the MsgBox, but inserting one seems to give me an error.
Not sure if it's necessary to display the entire code here as it's quite big but at the end of a subroutine I simply want ...
MsgBox ("Completed")
which is followed by the End Sub
However when I run this and then click on OK on the Msgbox, I get a runtime error which on clicking DeBug, it highlights the End Sub.
Is there any reason why having this would throw up such an error?
Am I missing something from it?
Many thanks
Some of the code here
'Add unique data to new location
For i = 1 To UnqArray1.Count
rCell(i, 1) = UnqArray1(i)
Next
'Move Split Array into a new array
Set rTable2 = rCell
rng2() = rTable2.Value
'Filter into unique items
On Error Resume Next
For Each b In rng2
UnqArray2.Add b, b
Next
'Clear location
rCell.Clear
'Add new array to location
For i = 1 To UnqArray2.Count
rCell(i, 1) = UnqArray2(i)
Next
'Find the end of the category list
lastrow = Worksheets("CatMatch").Range("Q100000").End(xlUp).Row
'Sort alphabetically
Worksheets("CatMatch").Range("Q1:Q" & lastrow).Sort key1:=Range("Q1"), order1:=xlAscending, Header:=xlNo
'Copy it to CatMatch
Worksheets("CatMatch").Range("Q1:Q" & lastrow).Copy Destination:=Worksheets("CatMatch").Range("B15")
MsgBox "Completed"
End Sub
I can't reproduce your error, but you are almost certainly incorrect that it runs okay without the MsgBox. The problem is that the problem with your code is being hidden by On Error Resume Next in the fragment:
'Filter into unique items
On Error Resume Next
For Each b In rng2
UnqArray2.Add b, b
Next
Two comments:
1) Why not use the RemoveDuplicates method if that is what you are trying to do?
2) Your code is using the fact that a collection throws an error if you try to add a duplicate key. This is a valid use of On Error Resume Next -- but only if you turn it off when you are done adding keys to the collection. Something like:
On Error Resume Next
For Each b In rng2
UnqArray2.Add b, b
Next
On Error GoTo 0
A good habit to get into is to consider On Error Resume Next and On Error GoTo 0 as defining a block of code, perhaps even indenting the code inside the block as I did above. An even better habit is to not assume that only 1 type of error can happen. The above code is expecting that error 457 might arise (this is the error number corresponding to trying to add a duplicate key -- you need to search documentation to find it, or just run your code without the error handling and see how it crashes). Anything else indicates some other problem. To be maximally safe you can do something like:
On Error Resume Next
For Each b In rng2
UnqArray2.Add b, b
If Err.Number > 0 And Err.Number <> 457 Then
MsgBox "Unhandled error: " & Err.Number
Exit Sub
End If
Next
On Error GoTo 0
Doing this won't solve your problem, but should make your actual problem more apparent.
I have a very strange problem here. Here's the code:
reqLang = "ENG"
Select Case reqLang
Case "CRO", "ENG"
'first loop -------------------------------------
On Error GoTo reqLangVisible
i = 1
'Loop until ccCROENG's are all hidden and then go to reqLangVisible.
Do
ActiveDocument.SelectContentControlsByTag("ccCROENG")(i) _
.Range.Font.Hidden = True 'hides all CCs
i = i + 1
Loop
reqLangVisible:
'second loop -------------------------------------
On Error GoTo langOut
i = 1
'Loop until ccreqLang's are all visible and then go to langOut.
Do
ActiveDocument.SelectContentControlsByTitle("cc" & reqLang)(i) _
.Range.Font.Hidden = False 'activates reqLang CCs
i = i + 1
Loop ' CAN'T GET OUT -----------------------------------
Case "CROENG"
i = 1
'Loop until ccCROENG's are all visible and then go to langOut.
Do
On Error GoTo langOut
ActiveDocument.SelectContentControlsByTag("ccCROENG")(i) _
.Range.Font.Hidden = False 'Shows all CCs
i = i + 1
Loop
End Select
langOut:
MsgBox "Success!" '------- yeah, not really.
Stop
I hope it's clear enough what it's trying to do (at least programming-wise). I have multiple ContentControls(CCs) with same titles and tags. The problem I end up with is marked with CAN'T GET OUT, because, you guessed it - I can't get of this second loop! I end up with the Out of range error because it runs out of CCs.
What's even weirder is that it actually did get out of the first loop which has the exact same On Error statement, thought pointing to a different section.
Is it me, or did I just - however unlikely - run onto a bug in VBA?
In any case, is there a solution or at least a workaround?
Typically you only use error handling for dealing with unexpected or unpredictable situations, such as not being able to access a drive, or finding you have no network access.
Error handling is not intended as a substitute for reasonable checks which could otherwise be done. i.e. collections have a Count property which you can use when looping over their items, so avoiding any error caused by trying to access Item(n+1) when there are only n items (and here you know n from Count). Alternatively, use a For Each loop.
Here's some sample code demonstrating use of two methods for looping over your controls:
Sub Tester()
Dim cc1 As ContentControls, cc2 As ContentControls
Dim c, i As Long
With ActiveDocument
Set cc1 = .SelectContentControlsByTag("tbTag")
Set cc2 = .SelectContentControlsByTitle("tbTitle")
End With
Debug.Print "cc1 has " & cc1.Count
Debug.Print "cc2 has " & cc2.Count
'use the Count property
For i = 1 To cc1.Count
Set c = cc1(i)
c.Range.Font.Hidden = True
Next i
'use a For Each loop
For Each c In cc2
c.Range.Font.Hidden = False
Next c
End Sub
This is the type of scenario for which this type of flow control is designed.
Applied to your original code:
Sub Tester2()
Dim reqLang, cc As ContentControls, c
reqLang = "ENG"
Select Case reqLang
Case "CRO", "ENG"
Set cc = ActiveDocument.SelectContentControlsByTag("ccCROENG")
SetTextHidden cc, True
Set cc = ActiveDocument.SelectContentControlsByTitle("cc" & reqLang)
SetTextHidden cc, False
Case "CROENG"
Set cc = ActiveDocument.SelectContentControlsByTag("ccCROENG")
SetTextHidden cc, False
End Select
MsgBox "Success!" '-- yeah really
End Sub
Sub SetTextHidden(cc As ContentControls, MakeHidden As Boolean)
Dim c
For Each c In cc
c.Range.Font.Hidden = MakeHidden
Next c
End Sub
So if you've read my comment, and to formally answer your question, it is not a bug.
You just need to use Error Handling Routines correctly.
What you're trying to do is somewhat like below. HTH.
Select Case reqlang
Case "CRO", "ENG"
On Error Resume Next '~~> ignores the error when encountered
'~~> Your loop which possibly creates the error goes here
On Error Goto 0 '~~> resets the actively triggered error handling
Case "CROENG"
On Error Resume Next '~~> ignores the error when encountered
'~~> Your loop which possibly creates the error goes here
On Error Goto 0 '~~> resets the actively triggered error handling
End Select
MsgBox "Success"
But as the link suggest, you need to handle errors and not simply disregard them. Try cheking on the actual error and find a way to correct it or avoid it.
You'll be surprise that you won't even be needing the Error Handling Routine.