How to disable pivot item only when it exists? - excel

In the following code, the line .PivotItems("Central Events").Visible = False will throw an error if such pivot item does not exist, hence I am currently ignoring the error with On Error Resume Next:
With BA_view_pivots_sheet.PivotTables("Corporate & Investment Banking").PivotFields( _
"Market")
On Error Resume Next ' ignore error when projects for Central Events does not exist
.PivotItems("Central Events").Visible = False
On Error GoTo 0
End With
However, instead of ignoring the error, I would like to implement a check if such pivot item exists and disable it only in such case. So I came up with something like this, but obviously it won't work, because the object is non- existent:
With BA_view_pivots_sheet.PivotTables("Corporate & Investment Banking").PivotFields( _
"Market")
If Not .PivotItems("Central Events") Is Nothing then
.PivotItems("Central Events").Visible = False
End if
End With
Is there any other way to get around this possible error, apart from ignoring it like in my first code snippet?

I think that you need something like this:
Dim pt As PivotTable, pivot_item As PivotItem
For Each pt In BA_view_pivots_sheet.PivotTables
If pt.Name = "Corporate & Investment Banking" Then 'check that pivot name exists
For Each pivot_item In pt.PivotFields("Market").PivotItems
If pivot_item.Name = "Central Events" Then 'check that item name exists
pivot_item.Visible = False: Exit For
End If
Next pivot_item: Exit For
End If
Next pt

Related

Find Cell Range Based on Two Criteria

I've put together some VBA to find the last row with a certain criterion that matches the current value in my loop, then take action. This VBA code works, until I realized that the worksheet can contain the matching value multiple times but with different dates in another column. So I'm now trying to add a second search criterion to my VBA.
Here is the snippet of VBA as of now.
For Each t In trans.Cells
On Error GoTo NxtT2
If t.Value = Empty Then
On Error GoTo 0
ty = t.Offset(0, -3).Value
tx = t.Offset(0, -6).Value
Set searchTerm = .Range("E:E")
Set where = searchTerm.Find(what:=ty, after:=searchTerm(1), searchdirection:=xlPrevious)
If t.Offset(0, -3).Value = where.Value And IsError(where.Offset(0, 3).Value) Then
t.Value = "#N/A"
End If
End If
NxtT:
On Error GoTo 0
If t.Offset(1, -3).Value = "" Then Exit For
Next t
NxtT2:
Resume NxtT
Basically what I'm trying to do is make the line Set where = searchTerm.Find(what:=ty, after:=searchTerm(1), searchdirection:=xlPrevious) to also include the txvalue along with the ty that is already in there.
Something like this, if possible?
Set where = searchTerm.Find(what:=ty & tx, after:=searchTerm(1), searchdirection:=xlPrevious)
But I know that is not the correct syntax for it.
Any advice on how to approach this in the simplest way?
Not an answer to the original question, but to the issue I created with my off-the-cuff code review.
Your error handling never properly wrapped up. The code still thought it was in the error handler because you "exited" the error handler with the Next, which you really can't do - you need to leave this "instance" of error handling with a Resume.
Give this a shot instead for the cleaned up error handling.
NOTE: I declared variables because I've got Option Explicit set, which you also should also have. I've made the brash assumption that you've got your variables declared outside the code you shared. Use the variables as you've declared them, not as my quickie patched Variant declarations.
Sub foo()
Dim t As Variant
Dim ty As Variant
Dim tx As Variant
For Each t In Cells
On Error GoTo ErrorHandler
If t.Value = Empty Then
On Error GoTo 0
ty = t.Offset(0, -3).Value
tx = t.Offset(0, -6).Value
Dim searchterm As Range
Set searchterm = .Range("E:E")
Dim where As Range
Set where = searchterm.Find(what:=ty, after:=searchterm(1), SearchDirection:=xlPrevious)
If t.Offset(0, -3).Value = where.Value And IsError(where.Offset(0, 3).Value) Then
t.Value = "#N/A"
End If
End If
Continue:
Next
CleanExit:
Exit Sub
ErrorHandler:
If t.Offset(1, -3).Value = "" Then
Resume CleanExit
Else
Resume Continue
End If
End Sub

Excel VBA Find Duplicates and post to different sheet

I keep having an issue with some code in VBA Excel was looking for some help!
I am trying to sort through a list of names with corresponding phone numbers, checking for multiple names under the same phone number. Then post those names to a separate sheet.
So far my code is:
Sub main()
Dim cName As New Collection
For Each celli In Columns(3).Cells
Sheets(2).Activate
On Error GoTo raa
If Not celli.Value = Empty Then
cName.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
Sheets(3).Activate
Range("a1").Offset(celli.Row - 1, 0).Value = Range("a1").Offset(cName(celli.Value) - 1, 0).Value
Resume Next
End Sub
When I try to run the code it crashes Excel, and does not give any error codes.
Some things I've tried to fix the issue:
Shorted List of Items
Converted phone numbers to string using cstr()
Adjusted Range and offsets
I'm pretty new to all this, I only managed to get this far on the code with help from other posts on this site. Not sure where to go with this since it just crashes and gives me no error to look into. Any ideas are appreciated Thank you!
Updated:
Option Explicit
Dim output As Worksheet
Dim data As Worksheet
Dim hold As Object
Dim celli
Dim nextRow
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(3).Cells
On Error GoTo raa
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
nextRow = output.Range("A" & Rows.Count).End(xlUp).Row + 1
output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
'data.Range("B1").Offset(celli.Row - 1, 0).Value = Range("B1").Offset(hold
Resume Next
End Sub
Update2:
Used hold.Exists along with an ElseIf to remove the GoTo's. Also changed it to copy and paste the row to the next sheet.
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(2).Cells
If Not hold.Exists(CStr(celli.Value)) Then
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
Else
End If
ElseIf hold.Exists(CStr(celli.Value)) Then
data.Rows(celli.Row).Copy (Sheets("phoneFlags").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
'output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
End If
Next celli
End Sub
When developing code, don't try (or be afraid of) errors as they are pointers to help fix the code or the logic. As such, don't use On Error unless it is absolutely indicated in the coding algorithm (*). using On Error when not necessary only hides errors, does not fix them and when coding it is always better to avoid the errors in the first place (good logic).
When adding to the Dictionary, first check to see if the item already exists. The Microsoft documentation notes that trying to add an element that already exists causes an error. An advantage that the Dictionary object has over an ordinary Collection object in VBA is the .exists(value) method, which returns a Boolean.
The short answer to your question, now that I have the context out of the way, is that you can first check (if Not hold.exists(CStr(celli.Value)) Then) and then add if it does not already exist.
(*) As a side note, I was solving an Excel macro issue yesterday which took me most of the day to nut out, but the raising of errors and the use of debugging code helped me make some stable code rather than some buggy but kind-of-working code (which is what I was fixing in the first place). However, the use of error handling can be a short cut in some instances such as:
Function RangeExists(WS as Worksheet, NamedRange as String) As Boolean
Dim tResult as Boolean
Dim tRange as Range
tResult = False ' The default for declaring a Boolean is False, but I like to be explicit
On Error Goto SetResult ' the use of error means not using a loop through all the named ranges in the WS and can be quicker.
Set tRange = WS.Range(NamedRange) ' will error out if the named range does not exist
tResult = True
On Error Goto 0 ' Always good to explicitly limit where error hiding occurs, but not necessary in this example
SetResult:
RangeExists = tResult
End Function

Error handling with loop and user input

For i = 1 To repNumber
TryAgain:
On Error GoTo ErrH:
repName = InputBox("Enter rep name you want to exclude.", "Name of Rep")
.PivotItems(repName).Visible = False
Next i
ErrH:
MsgBox "Try Again"
GoTo TryAgain:
It shows an error if I type in Rep name that doesn't exist in the PivotTable. So I'm trying to use an error handler to let a user type Rep name again.
But after the second time I type something wrong, instead of going to the error handler, the code terminates itself.
I'm not sure if 'On Error GoTo' is in the wrong line.
You can avoid Error Handing and GoTo statements all together (which is definitely best practice) by testing within the code itself and using If blocks and Do loops (et. al.).
See this code which should accomplish the same thing:
Dim pf As PivotField, pi As PivotItem
Set pf = PivotTables(1).PivotField("myField") 'adjust to your needs
For i = 1 To repNumber
Do
Dim bFound As Boolean
bFound = False
repName = InputBox("Enter rep name you want to exclude.", "Name of Rep")
For Each pi In pf.PivotItems
If pi.Value = repName Then
pi.Visible = False
bFound = True
Exit For
End If
Next pi
Loop Until bFound = True
Next i
Try Resume TryAgain instead of GoTo TryAgain.
(You don't need : in these statements, it is by coincidence allowed because it is also used to seperate multiple statements within a line, so it is just meaningless here).

Run-time error '-2147418113 (8000ffff)': Automation Error

My code is running perfectly until get to "If c = "" Then". At this point the run time error '-2147418113 (8000ffff)': Automation Error is raised. I have put an On Error Resume Next statement to check if everything goes right if I skip this line and it does. I really don't understand what this error means and I wasn't able to find useful information about it. Could someone bring light to this problem? I have tried to change "If c = "" Then" to "If len(c.value)=0 Then" but it raises the same error. All the variables in AddresRawDataFile are defined as public (as range) and they were set to range in a different module, called PublicVariable, which is called by every procedure.
Private Sub CommandButton3_Ok_Click()
Dim MsgAlert As String
Dim MsgBoxAlert As Variant 'Message box for for many checks done below
Dim c As Variant 'Variable used in a for each structure
Dim AddressRawDataFile As Variant 'Array of variables with address in Box2_UPb_Options
'Code to assign values from Box2_UPb_Options to the related variables
AddressRawDataFile = Array(RawHg202Range, RawPb204Range, RawPb206Range, RawPb207Range, RawPb208Range, RawTh232Range, RawU238Range, _
RawHg202Header, RawPb204HeaderRange, RawPb206HeaderRange, RawPb207HeaderRange, RawPb208HeaderRange, RawTh232HeaderRange, _
RawU238HeaderRange)
'All of the above variables must not be = ""
For Each c In AddressRawDataFile
'On Error Resume Next
If c = "" Then
MsgBoxAlert = MsgBox("There are one or more addresses missing in Start-AND-Options sheet. " & _
"Please, check it.", vbOKOnly, "Missing Address")
Load Box2_UPb_Options
Box2_UPb_Options.MultiPage1.Value = 2
Box2_UPb_Options.Show
End If
Next
As the items named RawHg202Range etc are actually Range objects then you should use Is Nothing to check if they are empty:
AddressRawDataFile = Array(RawHg202Range, RawPb204Range, RawPb206Range, RawPb207Range, RawPb208Range, RawTh232Range, RawU238Range, _
RawHg202Header, RawPb204HeaderRange, RawPb206HeaderRange, RawPb207HeaderRange, RawPb208HeaderRange, RawTh232HeaderRange, _
RawU238HeaderRange)
For Each c In AddressRawDataFile
If c Is Nothing Then

How to set a default error value?

For i = 1 To UBound(CementContractNo())
On Error Resume Next
Row = Application.Match(CementContractNo(i), Range("A:A"), 0)
MsgBox Row
CementStartDate(i) = Cells(Row, ContractStartCol).Value
If Cells(Row, ContractExtCol).Value <> "" Then
CementEndDate(i) = Cells(Row, ContractExtCol).Value
Else
CementEndDate(i) = Cells(Row, ContractEndCol).Value
End If
Next i
I am running the above code to find the start date and end date of an excel table. However, it would return an error when the table lookup fails. In this case, I would love to assign a default error value of "Missing" or something else to follow up. Any idea how to do it?
use a construction like this to precisely control what happens when you get an error
On Error Goto ErrHandling
'Your normal code
'at end of sub
ErrHandling:
'[Your code what happens when you get an error]
Resume Next 'will resume at previous location in code.
Read more here: http://www.cpearson.com/excel/errorhandling.htm

Resources