In my current version of Excel, the enumeration of xlNumberAsText seems inconsistent with both the documentation XlErrorChecks Enumeration (Excel) and prior usage recommended on SO. It seems that particular error is Item 4; whereas previous posts about clearing this error using VBA have used a constant of 3.
Is this a bug in Excel 2016? Or am I doing something incorrectly.
Here is code demonstrating the issue. And if you examine the worksheet after running the code, it is apparent that the error is flagged, in Excel, as NumberAsText and not as Inconsistent Formula.
Option Explicit
Sub foo()
Dim I As Long
Dim B As Boolean
Dim S As String
Dim R As Range
'Save current state
B = Application.ErrorCheckingOptions.NumberAsText
'Enable
Application.ErrorCheckingOptions.NumberAsText = True
Set R = Cells(1, 1)
With R
.Clear
.NumberFormat = "#"
.Value = "1"
End With
For I = 1 To 10
S = S & vbLf & I & vbTab & R.Errors(I).Value
Next I
S = Mid(S, 2)
'Restore original state
Application.ErrorCheckingOptions.NumberAsText = B
MsgBox S
End Sub
And also, in trying to clear the error box, I must use
R.Errors(4).Ignore = True
Neither Errors(3), nor Errors(xlNumberAsText) will have any affect on the error box.
I've noted other inconsistencies with the enum and the documentation:
Inconsistent Formula: 5
Wrong Data Type: 2
I'm not going to bother to check the rest. But I am going to try to report it to MS. Thanks to those who confirmed this problem.
Followup: I reported this to MS via the Feedback option within Excel. And after this morning's update, the problem seems to have been corrected.
Related
Hi please can someone help, Excel 2016 VBA PivotTable objects. I rarely develop in Excel VBA.
Overall goal:
Compare a single column [P_ID] value list from PivotTable2 against PivotTable1 if they exist or not to enable filtering on those valid values in PivotTable1.
I have some Excel 2016 VBA code which I have adapted from a previous answer from a different internet source.
Logic is: gather data from PivotTable2 from the ComparisonTable dataset (in PowerPivot model), field [P_ID] list of values. Generate a test line as input into function to test for existence of field and value in PivotTable1 against the Mastertable dataset, if true add the line as valid if not skip the line.
Finally filter PivotTable1 with the VALID P_ID values.
It works to a point until it gets to the bFieldItemExists function which generates an error:
Run-time error '1004'
Unable to get the PivotItems property of the PivotField class
Can someone please correct the way of this not working?
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim MyArray As Variant, _
ar As Variant, _
x As String, _
y As String, _
str As Variant
MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("[ComparisonTable].[P_ID].[P_ID]").DataRange
For Each ar In MyArray
x = "[MasterTable].[P_ID].&[" & ar & "]"
If ar <> "" And bFieldItemExists(x) = True Then
If str = "" Then
str = "[MasterTable].[P_ID].&[" & ar & "]"
Else
str = str & "," & "[MasterTable].[P_ID].&[" & ar & "]"
End If
End If
Next ar
Dim str2() As String
str2 = Split(str, ",")
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").VisibleItemsList = Array(str2)
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Function bFieldItemExists(strName As String) As Boolean
Dim strTemp As Variant
' This line does not work!?
strTemp = ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").PivotItems(strName)
If Err = 0 Then bFieldItemExists = True Else bFieldItemExists = False
End Function
The 1004 error occurred due to the use of square brackets [ ]. Remove those.
You also need to use the key word Set when you set an object equal to something. For example Set MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("ComparisonTable.P_ID.[P_ID").DataRange.
If you don't use Set you will get a VBA run-time error dialog that says Run-time error '91': Object variable or With block variable not set
I cannot guarantee that my edits will completely solve your problem since I don't have your data set and cannot fully test your code. You will need to use the Debug mode in the VBA editor and single step through the code. To this set a breakpoint on the Set mDataRange = Active.... To set a breakpoint go to the Debug menu and choose the "Toggle Breakpoint" sub-menu item or you can press F9 to set the breakpoint.
Now when you make a change to the Pivot table, the Worksheet_PivotTableUpdate event will fire and the code will top execution at that point.
After the code stops executing due to the breakpoint, you can press the F8 key to single step through your code. If you want to resume execution to the next breakpoint you can press F5. Also when you get the VBA error dialog box, you can hit Debug and then use the F8 key to single step or use the debug windows to see what your variables and objects contain. I'm sure there are some good youtube videos on VBA debugging.
As you single step through the code, you can observe what each variable/object contains using the Immediate window, the Watches window and the Locals window. To open these windows, go to the menu item View and click on each of these sub-menu items.
Here's how you need to edit your code before debugging.
Option Explicit
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'Better practice is to not use the underscore character to
'continue a Dim declaration line
Dim mDataRange As Range
Dim ar As Range
Dim x As String
Dim y As String
Dim str As Variant
'Use Set to assign the object mDataRange a reference to the the right
'hand side of the equation. Remove the square brackets
'MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("[ComparisonTable].[P_ID].[P_ID]").DataRange
Set mDataRange = ActiveSheet.PivotTables("PivotTable2").PivotFields("ComparisonTable.P_ID.P_ID").DataRange
For Each ar In mDataRange
'You need to specify what proprerty from ar you
'want to assign to x. Assuming the value stored in
'ar.Value2 is a string, this should work.
'We use value2 because it is the unformmated value
'and is slightly quicker to access than the Text or Value
'properties
'x = "[MasterTable].[P_ID].&[" & ar & "]"
x = "MasterTable.P_ID." & ar.Value2
'Once again specify the Value2 property as containing
'what value you want to test
If ar.Value2 <> "" And bFieldItemExists(x) = True Then
If str = "" Then
'Remove the square brackets and use the specific property
'str = "[MasterTable].[P_ID].&[" & ar & "]"
str = "MasterTable.P_ID." & ar.Value2
Else
'Remove the square brackets and use the specific property
'str = str & "," & "[MasterTable].[P_ID].&[" & ar & "]"
str = str & "," & "MasterTable.P_ID." & ar.Value2
End If
End If
Next ar
Dim str2() As String
str2 = Split(str, ",")
Application.EnableEvents = False
Application.ScreenUpdating = False
'Remove square brackets
'ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").VisibleItemsList = Array(str2)
ActiveSheet.PivotTables("PivotTable1").PivotFields("MasterTable.P_ID.P_ID").VisibleItemsList = Array(str2)
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Function bFieldItemExists(strName As String) As Boolean
'Declare a PivotItem to accept the return value
Dim pvItem As PivotItem
'Since you want to trap for an error, you'll need to let the VBA runtime know
'The following code is a pseudo Try/Catch. This tells the VBA runtime to skip
'the fact an error occured and continue on to the next statement.
'Your next statement should deal with the error condition
On Error Resume Next
'Use Set whenever assigning an object it's "value" or reference in reality
Set pvItem = ActiveSheet.PivotTables("PivotTable1").PivotFields("MasterTable.P_ID.P_ID").PivotItems(strName)
'Assuming that an error gets thrown when strName is not found in the pivot
'Err is the error object. You should access the property you wish to test
If Err.Number = 0 Then
bFieldItemExists = True
Else
bFieldItemExists = False
End If
'Return to normal error functioning
On Error GoTo 0
End Function
Finally, I realize that some of this should be in the comments section, but there was too much I needed to explain to help Learner74. BUT most importantly, I hope I helped him. I have used so many suggestions, recommendations and explanations from the VBA Stack Overflow exchange through the years, I just want to pay it back by paying it forward.
Additional USEFUL Links:
Chip Pearson is the go to site and person for all things VBA
Paul Kelly's Excel Macro Mastery is another go to site for Excel and VBA questions.
Microsoft Excel Object Model which is sometimes useful, but needs improvement. Too many of the objects lack examples, but can at least point you in the right direction.
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.
Trying to hammer out bugs in my code. Currently trying to do some very simple, open worksheet, copy and paste data over. Trying to do it all without using .Select or .Activate. Hitting "Application-defined or Object defined error", which, from reading the other threads on the matter, probably means that my statements aren't fully qualified. However, I can't figure out how they're not fully qualified - other posts on the topic seem to be missing a "." somewhere in the code, but my attempts to fix it haven't gotten anywhere. Heavily truncated code as follows (If you don't see it dimmed/defined, it's elsewhere)
Sub CopyPaste()
Dim CitiReportEUR As Workbook
Dim CitiReportPathEUR As String
CitiReportPathEUR = Range("CitiReportPathEUR")
Workbooks.Open Filename:=CitiReportPathEUR
Set CitiReportEUR = ActiveWorkbook
LastRowCiti = CitiReportEUR.Sheets(1).Range("I" & Rows.Count).End(xlUp).Row
Set RngCitiEUR = CitiReportEUR.Sheets(1).Range("A1:CT" & LastRowCiti).SpecialCells(xlCellTypeVisible)
Set CabReport.Sheets("CITI").Range("C1").Resize(RngCitiEUR.Rows.Count).Value = RngCitiEUR.Value
End Sub
Currently the error is occurring when I define the range. I've had problems historically with pasting into the range as well... but that's an issue for when I can actually get the code to run that far!
Rows.Count is implicitly working with the ActiveSheet.
The use of Set when assigning values to the Value property of a Range is inappropriate. Set should only be used when assigning a reference to an object.
The Resize probably needs to cater for the number of columns in the source as well as rows.
This code is more explicit:
Sub CopyPaste()
Dim CitiReportEUR As Workbook
Dim CitiReportPathEUR As String
CitiReportPathEUR = Range("CitiReportPathEUR")
Set CitiReportEUR = Workbooks.Open(Filename:=CitiReportPathEUR)
With CitiReportEUR.Sheets(1)
LastRowCiti = .Range("I" & .Rows.Count).End(xlUp).Row
Set RngCitiEUR = .Range("A1:CT" & LastRowCiti).SpecialCells(xlCellTypeVisible)
End With
CabReport.Sheets("CITI").Range("C1").Resize(RngCitiEUR.Rows.Count, RngCitiEUR.Columns.Count).Value = RngCitiEUR.Value
End Sub
This code feels like Schrodinger is executing it. If I open the project and run the code, I won't get any errors at all. If I view the code to edit or add anything, the first time I run the code, I get 'Run-time error 91'. If I try to run it a second time, making no changes, I get 'Run-time error 429' (ActiveX component can't create object).
What I'm trying to achieve is to find the row (BuildSel) in a range on worksheet (Ref) that has the same value as what's selected in a list on a userform (BuildList). Then once the row is found, to take data from that row and columns A and B, and put them in textbox's on my userform. Is my code right and ActiveX making the error? I apologize for terrible coding too.
EDIT: The listbox is on a multipage on my userform. I first noticed the issue today when I tried adding another listbox on a different page.
Private Sub BuildList_Click()
Dim Ref As Worksheet, BuildSel As Long
Set Ref = ThisWorkbook.Sheets("Ref")
BuildSel = Ref.Range("B2", Ref.Range("B" & Rows.Count).End(xlUp)).Find(BuildList.Value, lookat:=xlPart).Row
BuilderText.Value = Ref.Range("A" & BuildSel).Value
CompNameText.Value = Ref.Range("B" & BuildSel).Value
End Sub
Not sure why altering 'BuildSel' to variant makes it work, but the code as it stands has no error checking for when there is no matching list item to be found
The following code should be better suited for usage:
Private Sub BuildList_Click()
Dim Ref As Worksheet: Set Ref = ThisWorkbook.Sheets("Ref")
Dim BuildSel As Range
With Ref
Set BuildSel = .Range("B2", .Range("B" & Rows.Count).End(xlUp)).Find _
(BuildList.Value, lookat:=xlPart)
If Not BuildSel Is Nothing Then
BuilderText.Value = .Range("A" & BuildSel.Row).Value
CompNameText.Value = .Range("B" & BuildSel.Row).Value
Else
BuilderText.Value = ""
CompNameText.Value = ""
End If
End With
End Sub
Disclaimer: It's been a few years since I worked (a lot) with VBA, so this might be an issue caused by confusing myself with what is essentially a very different language from what I usually deal with.
So; I've got a workbook (Excel 2010) with multiple sheets (20+), most of whom are multi-page. To make things easier when printing everything, I want to add some sheet-specific headers with amongst others the name of the sheet, number of pages and so on.
I've written a tiny function that should (in theory) do this for me by iterating over all the sheets setting the header. However, for some reason it only works if the header is empty; if it already has a value it refuses to overwrite for some unknown reason.
Dim sheetIndex, numsheets As Integer
sheetIndex = 1
numsheets = Sheets.Count
' Loop through each sheet, but don't set any of them to active
While sheetIndex <= numsheets
Dim sheetname, role, labeltext As String
sheetname = Sheets(sheetIndex).name
role = GetRole(mode)
labeltext = "Some text - " & sheetname & " - " & role
With Sheets(sheetIndex).PageSetup
.LeftHeader = labeltext
.CenterHeader = ""
.RightHeader = "Page &[Page] / &[Pages]"
.LeftFooter = "&[Date] - &[Time]"
.CenterFooter = ""
.RightFooter = "Page &P / &N"
End With
sheetIndex = sheetIndex + 1
Wend
I found a solution that seems to work for replacing text. For whatever reason, in the macro, you need to include the header/footer format character codes in order for it to work properly.
This code worked to replace existing header text with new information:
Sub test()
Dim sht As Worksheet
Set sht = Worksheets(1)
sht.PageSetup.LeftHeader = "&L left text"
sht.PageSetup.CenterHeader = "&C center Text"
sht.PageSetup.RightHeader = "&R right text"
End Sub
Without the &L, &C, and &R codes before the text, I could not get it to work.
Some interesting behavior I found is that if you use the following code:
.CenterHeader = "&L some text"
it will actually put the some text in the LeftHeader position. This led me to believe that the formatting codes were very important.
The line Application.PrintCommunication = False (which is added by the macro recorder) before doing PageSetup screws up the formating via VBA.
If your code has got this line in it, try removing it. That solved my problem with setting the header and footer via VBA.
I've read StackOverflow for years and this is the first time I've actually been able to post a solution ... hope it helps someone!! Also, you need to remember, I am a CPA not a programmer ;-)
I am reading some values from the ActiveSheet to populate the header. The application is a tax election that will be sent with a tax return so it must have the taxpayer's name and social security number at the top.
Sub PrintElection()
' Print preview the MTM Election
If Range("Tax_Year").Value = Range("First_MTM_year").Value Then
ActiveSheet.PageSetup.LeftHeader = Format(Worksheets("Election").Range("Taxpayer_Name").Value)
ActiveSheet.PageSetup.RightHeader = Format(Worksheets("Election").Range("Taxpayer_SSN").Value)
ActiveWindow.SelectedSheets.PrintPreview
Else
MsgBox "The 'Effective For Tax Year' date must EQUAL the 'First MTM year' date", vbOKOnly, "Check Years"
Sheets("Roadmap").Select
Range("First_MTM_year").Select
End If
End Sub
It checks to see if the Mark-to-Market election year is the same as the election form then formats the election page.
I split the sheet print setup into 2 loops. First loop with Application.PrintCommunication = False I run the non-header/footer setup. I then set Application.PrintCommunication = True and run the header/footer setup in a second loop. Appears to run faster than in XL2003, and applies the header/footer correctly. Until MS fixes this bug, that works fine for me.