I currently have the following code to set a range from my pivot table (the dataset is for regional income):
Set RngE1 = PT.PivotFields("Region").PivotItems("Europe").LabelRange
Set RngE2 = Intersect(PT.PivotFields("Region").PivotItems("Europe").DataRange.EntireRow, PT.PivotFields("Income").DataRange)
Set RngEurope = Union(RngE1, RngE2)
However this is a monthly report and in certain months there will be no income for Europe. As such, I would run into an error whereby the macro cannot get the LabelRange of the PivotItem class. Is there any code I can use that would skip this step if the LabelRange is not found, rather than break the macro?
Thanks
Its nasty but what about just an error trap?
Dim bTest as Boolean
bTest = False
' ----------
On Error Resume Next
Set RngE1 = PT.PivotFields("Region").PivotItems("Europe").LabelRange
If Err Then bTest = True
On Error Goto 0
If bTest Then
'Handle here
Else
'All good
End If
Related
I am using below VBS code to export one chart (from QlikView) to excel.
Reason I am using Number format = ‘#’ and paste special because if I do not use it then values in the chart like ‘22001E-07’ gets converted to 2.20E-03
sub GPOTest1
set oXL=CreateObject("Excel.Application")
oXL.visible=True
oXL.Workbooks.Add
aSheetObj=Array("CH01")
for i=0 to UBound(aSheetObj)
oXL.Sheets.Add
Set oSH = oXL.ActiveSheet
oSH.Range("A1").Select
Set obj = ActiveDocument.GetSheetObject(aSheetObj(i))
obj.CopyTableToClipboard True
oSH.Columns("B").NumberFormat = "#" ‘In “B” column I get values like 22001E-07
oSH.PasteSpecial -4163
sCaption=obj.GetCaption.Name.v
set obj=Nothing
oSH.Rows("1:1").Select
oXL.Selection.Font.Bold = True
oSH.Cells.Select
oXL.Selection.Columns.AutoFit
oSH.Range("A1").Select
oSH.Name=left(sCaption,30)
set oSH=Nothing
next
set oXL=Nothing
end sub
After running it for the first time, from 2nd time I get message
PasteSpecial method of Worksheet class failed
Referred following link, however, issue persists:
use macro to convert number format to text in Excel
You shouldn't systematically create an Excel instance. Your code leaves Excel open. Once Excel is open, the next time around, you can get a reference to it using GetObject. See the approach taken in the code below, where I've also simplified a couple things:
Sub GPOTest1()
On Error Resume Next
Set oXL = CreateObject("Excel.Application")
If oXL Is Nothing Then
Set oXL = GetObject(Class:="Excel.Application")
End If
On Error GoTo 0
oXL.Visible = True
Set oWB = oXL.Workbooks.Add
aSheetObj = Array("CH01")
For i = 0 To UBound(aSheetObj)
Set oSH = oWB.Sheets.Add
Set obj = ActiveDocument.GetSheetObject(aSheetObj(i))
obj.CopyTableToClipboard True
oSH.Columns("B").NumberFormat = "#" 'In “B” column I get values like 22001E-07
oSH.PasteSpecial -4163
oSH.Rows("1:1").Font.Bold = True
oSH.Columns.AutoFit
oSH.Range("A1").Select
oSH.Name = Left(obj.GetCaption.Name.v, 30)
Set oSH = Nothing
Set obj = Nothing
Next
Set oXL = Nothing
End Sub
I have been working on Excel and VBA and I am trying to figure out how to deselect various fields from my slicer and only select few.
I try to read the slicer Cache and then iterate over various items within the slicer. I am able to read the values of the items within the slicer, but i am unable to deselect them. It keeps on throwing up an "application-defined or Object-defined error" with the error code 1004.
I am sharing the code snippet i am facing difficulty with.
Sub SelectFiscalWeeks()
Dim slcCache As SlicerCache
Dim slcItem As SlicerItem
FalseVar = False
Application.StatusBar = "Filtering out last 13 Week's Data"
Set slcCache = ThisWorkbook.SlicerCaches("Slicer_Date.Fiscal_Week")
slcCache.ClearManualFilter
For Index = 1 To slcCache.SlicerCacheLevels.Count
Worksheets("A").Cells(Index + 1, "N").Value = Index
j = 0
For Each slcItem In slcCache.SlicerCacheLevels(Index).SlicerItems
Worksheets("A").Cells(j + 1, "P").Value = slcItem.Name
j = j + 1
slcItem.Selected = FalseVar
Next
Next
'Set slcCache.VisibleSlicerItems = Array("[DT].[FW].&[201701]")
Set slcCache = Nothing
Application.StatusBar = False
End Sub
In the above code I am able to read the Slicer Item names by using slcItem.Name, but I am unable to Execute either of the following statements:
slcItem.Selected = FalseVar
Set slcCache.VisibleSlicerItems = Array("[DT].[FW].&[201701]")
Executing these statements throws up an error "application-defined or Object-defined error" with the error code 1004.
I have been trying debugging for more than an hour but am unable to figure out the cause. It might be something basic, but can you please help me identify what might be wrong with my code?
Yea, I've been debugging for couple hours with the same problem you have.
Finally I found I should use VisibleSlicerItems instead of setting .selected to be true/false.
Try slcCache.VisibleSlicerItems = Array("[DT].[FW].&[201701]") without Set.
Here is my code as example.
Hope could help you.
Option Explicit
Sub Test()
Dim sc As SlicerCache
Dim si As SlicerItem
Dim list As Variant
Set sc = ActiveWorkbook.SlicerCaches("Slicer_product_name")
For Each si In sc.SlicerCacheLevels(1).SlicerItems
If InStr(si.Value, "Boxers") > 0 Then
'this if loop creates an Array for VisibleSlicerItems
If IsEmpty(list) Then
list = Array(si.Name)
Else
ReDim Preserve list(UBound(list) + 1)
list(UBound(list)) = si.Name
End If
End If
Next
sc.VisibleSlicerItemsList = list
End Sub
Description:
I have created a custom dropdown data validation list where I can choose among several values. These values on the dropdown list changes as I need (are defined in a worksheet column X).
Problem:
My problem occurs when I choose one of those values, let say Y, from the dropdown list and then I update the data validation by removing the last inserted value (deleted the Y value from column X). By doing this the value Y present in the worksheet is no longer valid so I would like to know if there is a way to obtain a list (array or string) of cells with the invalid data.
What I have done/thought so far:
I have searched in several sites and read similar questions but I cannot find anything usefull. I thought about looping all the cells and check if the value is valid but since I have a huge amount of data I think that it is not the best approach.
Since Excel already mark these invalid data with a red circle maybe it could be possible to get the address of those marked cells?
Thanks in advance!
The correct way to obtain the invalid cells in a worksheet is using Cells.SpecialCells(xlCellTypeAllValidation).
By using some information present in Microsoft KB213773 (Q213773) - "How to create data validation circles for printing in Excel" a similar Sub can be used to loop all invalid cells and then change their values (or mark them to future edit).
Sub CorrectInvalidValues()
Dim data_range As Range
Dim invalid_cell As Range
Dim count As Integer: count = 0
Dim nr_invalid As Integer: nr_invalid = 0
Dim new_value As String
'If an error occurs run the error handler and end the procedure
On Error GoTo errhandler
Set data_range = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
' Loop through each cell that has data validation and gets the number of invalid cells
For Each invalid_cell In data_range
If Not invalid_cell.Validation.Value Then
nr_invalid = nr_invalid + 1
End If
Next
' Editing each value
For Each invalid_cell In data_range
If Not invalid_cell.Validation.Value Then
count = count + 1
Application.Goto reference:=invalid_cell, Scroll:=True
new_value = Application.InputBox("Please insert a correct value.", "Invalid Data " & count & "/" & nr_invalid)
If Not (new_value = "False") Then
invalid_cell.Interior.ColorIndex = 0
invalid_cell.Value = new_value
Else
invalid_cell.Interior.Color = RGB(255, 0, 0)
invalid_cell.Value = "<PLEASE EDIT>"
End If
End If
Next
Exit Sub
errhandler:
MsgBox "There are no cells with data validation on this sheet."
End Sub
I try to create a macro, placed in Workbook_Open() procedure, which adds items for combo boxes, named CBTask for each sheet in workbook, (which has combo box named CBTask in it).
Unfortunatelly following code generates Compile error: Method or data member not found"
I believe it is because not every sheet has CBTask in it (even on error resume next does not help).
Is there any way to check if sheet contains combo box, so I could do the checking before trying clear it, or adding new items?
Private Sub Workbook_Open()
Dim ws As Worksheet
Dim i As Integer
Dim strTaskName As String
On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
ws.CBTask.Clear
strTaskName = taskName(1)
Do
ws.CBTask.AddItem strTaskName
strTaskName = taskName(i)
i = i + 1
Loop While taskName <> "LastOne"
Next ws
On Error GoTo 0
End Sub
(as you can see, this code also uses additional function "taskName(intSubtaskValue as integer)" to convert integer to string (e.g. taksName(1) = "Task01", taskName(2) = "Task02...)
The Worksheet class doesn't have a member named CBTask which is why that code fails. I suggest you use the OLEObjects property instead:
ws.OLEObjects("CBTask").Object.Clear
To expand on Rory's answer, in addition to fully qualifying your objects, you can check if an ActiveX-control of a given name exists on a worksheet by using this function:
Function obj_exists(obj_name As String, on_worksheet As Worksheet) As Boolean
On Error GoTo errHandler
Debug.Print on_worksheet.OLEObjects(obj_name).Name
obj_exists = True
On Error GoTo 0
Exit Function
errHandler:
obj_exists = False
On Error GoTo 0
End Function
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.