I believe this one will be very quick one.
I've written a code that allows to add trendline to the chart if there're certain slicer item selected. However, I wanto to include both Add and Remove trendline depending on the condition (If selected, remove and opposite).
The code worked when it was split into 2 subs, but when I include & modify it doesn't.
The code fails if statement: If x.Selected Then. However, the problem I think is in If ActiveChart.SeriesCollection(1).Trendlines(1).Selected.
How can it be tested if there's a trendline already? If yes - remove, if no - add. Simple as that.
Sub trend_add_remv()
Dim x As Excel.SlicerItem, slicer_x As Excel.SlicerCache
Set slicer_x = ActiveWorkbook.SlicerCaches("Slicer_x")
Application.ScreenUpdating = False
For Each x In slicer_x.SlicerItems
If x.Selected Then 'This part always fails despite the condition is true
ActiveSheet.ChartObjects("Chart 1").Activate
If ActiveChart.SeriesCollection(1).Trendlines(1).Selected Then
ActiveChart.SeriesCollection(1).Trendlines(1).Delete
ActiveSheet.ChartObjects("Chart 1").Selected = False
Else
With ActiveChart
.SeriesCollection(x.Value & " - " & "Actual Sales").Select
.SeriesCollection(x.Value & " - " & "Actual Sales").Trendlines.Add
End With
ActiveSheet.ChartObjects("Chart 1").Selected = False
End If
End If
On Error GoTo Message
Next x
Exit Sub
Message:
MsgBox "No actual sales or not selected in the slicer!"
Application.ScreenUpdating = True
End Sub
Can anyone help me find the solution and give a brief explanation (as part of my learning) why this happened? I would appreciate :)
Thanks for John Coleman's answer, the code now works, and here's the resolution:
Sub trendline_add()
Dim x As Excel.SlicerItem, slicer_x As Excel.SlicerCache
Set slicer_x = ActiveWorkbook.SlicerCaches("Slicer_x")
Application.ScreenUpdating = False
For Each x In slicer_x.SlicerItems
If x.Selected Then
ActiveSheet.ChartObjects("Chart 1").Activate
If ActiveChart.SeriesCollection(x.Value & " - " & "Actual _
Sales").Trendlines.Count > 0 Then
ActiveChart.SeriesCollection(x.Value & " - " & "Actual _
Sales").Trendlines(1).Delete
Else
ActiveChart.SeriesCollection(x.Value & " - " & "Actual Sales").Select
ActiveChart.SeriesCollection(x.Value & " - " & "Actual Sales").Trendlines.Add
End If
End If
On Error GoTo Message
Next x
Exit Sub
Message:
MsgBox "No actual sales or not selected in the slicer"
Application.ScreenUpdating = True
End Sub
Related
So I have a UserForm that is triggered with the entry of a string in an InputBox. The user the selected from the list of populated ListBox items and presses a command button. This is supposed to redirect to the corresponding sheet in my workbook that contains the selection. To achieve this, I have to loop through the cells in a range defined in the For Each loop. I have done something similar many times before, with nearly identical loops, but for whatever reason, cell in the code below is Empty when I run the code, so I get error when I get to here: rosterSh.Rows(stuAddr & ":" & stuAddr).Select What's going on?
Private Sub OK_Click()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
' Set sheet to current sheet
Dim rosterSh As Worksheet, rosterShName As String
Dim stuCount As Integer, lastStuRow As Integer
Dim selectedStu As String, stuAddr As String
If ListBox1.ListIndex < 0 Then
MsgBox "You did not make a selection. Please make a selection or press " & Chr(34) & "Cancel" & Chr(34) & " to continue.", vbExclamation, "Alert"
Exit Sub
Else
selectedStu = ListBox1.List(ListBox1.ListIndex)
rosterShName = Replace(Split(selectedStu, "[")(1), "]", "") & " Roster"
Set rosterSh = ThisWorkbook.Sheets(rosterShName)
rosterSh.Activate
' Find selection on sheet, activate sheet and highlight student
stuCount = rosterSh.Cells(Rows.Count, "A").End(xlUp).row - 1
lastStuRow = stuCount + 1
Dim cell As Variant
For Each cell In rosterSh.Range("A2:A" & lastStuRow)
If InStr(cell.Value, Trim(Left(selectedStu, InStr(selectedStu, "[")))) > 0 Then
Debug.Print "cell is: " & cell
stuAddr = Split(cell.Address, "$")(1)
End If
Next cell
rosterSh.Rows(stuAddr & ":" & stuAddr).Select
End If
Call unloadUserForm9
UserForm9.Hide
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
EDIT: apologies for not being more clear about the error. I get a Run-time error '13': Type mismatch, which doesn't happen with nearly identical loops I have used.
I am trying to check whether certain boxes are checked complete.
If any of the boxes are marked incomplete, prompt the user with a warning message.
If all are marked complete, move on to the next step in the overall macro.
Sub check_complete()
Dim x As Integer
For x = 10 To 19
If Cells(x, 16).Value = "Complete" Then
End If
If Cells(x, 16).Value = "Incomplete" Then
Result = MsgBox("We noticed that you have not uploaded all of the data. Would you still like to continue?", vbYesNo + vbExclamation, "Error: Incomplete Data")
If Result = vbYes Then
End If
Else
End If
If Cells(x, 16) <> "Complete" <> "Incomplete" Then
Result = MsgBox("We noticed an error in your checklist." & vbNewLine & "The checklist items should be marked as Complete/Incomplete." & vbNewLine & vbNewLine & "Would you like to continue anyway?" & vbNewLine & "(Doing so may create issues in finalizing your data)", vbYesNo + vbExclamation, "Error: Incomplete Data")
If Result = vbYes Then
End If
Else
End If
Next x
End Sub
The code refers to a group of cells that either contain the text "Complete" or "Incomplete".
As the user moves through the group of macros, the cells automatically change from Incomplete to Complete.
If they skip a step, I would like to warn them.
Edit: I tinkered around with the code and found the answer to my own question. I figured I would share in case anyone ever has this question in the future.
My newly corrected [working] code is as follows:
Sub check_complete()
Dim x As Integer
Dim y As Integer
Sheets("Updating Data").Select
x = 10
y = 19
On Error GoTo eh
Do While x < y
Cells(x, 16).Select
If Selection.Value = "Incomplete" Then
Err.Raise Error_INVALID_DATA, "Updating Data", "Data upload not complete"
End If
x = x + 1
Loop
Done:
Exit Sub
eh:
Result = MsgBox("We noticed that you have not uploaded all of the data. Would you still like to continue?", vbYesNo + vbExclamation, "Error: Incomplete Data")
If Result = vbYes Then
On Error Resume Next
Else:
End
End If
End Sub
I have a userform where you have to enter data into textboxes and then press a button to put the data into the sheet. When I'm typing into the last textbox and I'm done, I click the button and it doesn't respond. Also, I have noticed that my cursor keeps blinking inside the last textbox so I guess there's a problem there (while focused not able to click a button)?
In total I have 4 textboxes, 3 of them use data validation after their value has been updated. The last one does not have data validation.
The weird thing is that, next to the "next button", I have a button to clear the fields and that one works just fine. Below an image from my userform with a little bit of explanation because it's in another language (Dutch). Can anyone help me? Thanks!
The code used for the "next" button is:
Note: the data gets validated not only when they updated the value of the textbox, but also an extra time when they click the next button.
Private Sub AddNextBtn_Click()
AddValueMod.AddDisplayOverview
End Sub
Sub AddDisplayOverview() 'This sub is in the "AddValueMod" module
'Check if information is valid via a function
If AddInformationValid("AccountSelector", True) And AddInformationValid("Date", True) And AddInformationValid("Amount", True) And AddInformationValid("Description", True) Then
'If valid, retrieve entered values
Dim account, dDate, amount, description As String
account = main.AddAccountSelector.Value
dDate = main.AddDateInput.Value
amount = main.AddValue.Value
description = main.AddDescription.Value
'Ask for sheet-writing-confirmation
overview = MsgBox("Kloppen volgende gegevens (kijk goed na!)?" & vbCrLf & vbCrLf & "Rekening: " & account & vbCrLf & "Datum: " & dDate & vbCrLf & "Bedrag: " & amount & vbCrLf & "Beschrijving: " & description & vbCrLf & "Vermeerdering/vermindering: Waarde wordt vermeerderd", vbYesNo + vbQuestion, "Kloppen volgende gegevens?")
If overview = vbYes Then
'Write data to sheet
AddValueMod.AddEnterDataIntoSheet
End If
End If
End Sub
And for the "clear fields" button:
Private Sub AddClearFieldsBtn_Click()
AddValueMod.AddClearFields (True)
End Sub
Sub AddClearFields(askForConfirmation As Boolean) 'This sub is in the "AddValueMod" module
grey = RGB(128, 128, 128)
'If askForConfirmation = True, ask for confirmation before clearing fields
If askForConfirmation = True Then
confirmationMessage = MsgBox("Bent u zeker dat u de velden wilt leegmaken?" + vbCrLf + "U zal terug opnieuw moeten beginnen.", vbYesNo + vbQuestion, "Velden leegmaken?")
If confirmationMessage = vbYes Then
'Clear fields
main.AddAccountSelector.Value = ""
main.AddDateInput.Value = ""
main.AddValue.Value = ""
main.AddDescription.Value = ""
End If
ElseIf askForConfirmation = False Then
'Clear fields
main.AddAccountSelector.Value = ""
main.AddDateInput.Value = ""
main.AddValue.Value = ""
main.AddDescription.Value = ""
End If
'Reset the textboxes' borders (they change if an input error occurred)
main.AddAccountSelectorError.Visible = False
main.AddAccountSelector.BorderStyle = fmBorderStyleSingle
main.AddAccountSelector.BorderColor = grey
main.AddDateInputError.Visible = False
main.AddDateInput.BorderStyle = fmBorderStyleSingle
main.AddDateInput.BorderColor = grey
main.AddValueError.Visible = False
main.AddValue.BorderStyle = fmBorderStyleSingle
main.AddValue.BorderColor = grey
main.AddDescriptionError.Visible = False
main.AddDescription.BorderStyle = fmBorderStyleSingle
main.AddDescription.BorderColor = grey
End Sub
P.S.: I've already tried a possible solution with IsCancel = True/False that I found online in this article. It's possible it didn't work because the article is not quite related to my problem but I felt like I should mention it :).
You did not provide all relevant code. AddInformationValid() and AddEnterDataIntoSheet are missing.
However, if the AddInformationValid() returns False on any item, the behaviour is just as you describe. In AddDisplayOverview() there will be no error message, the AddEnterDataIntoSheet sub will be bypassed and on return from the button handler the cursor remains flashing in the last entry field.
You need to verify and correct the AddInformationValid() Function.
I also strongly recommend to show an error message if the data validation fails.
I'm struggling getting my code to work.
I have a button on the excel sheet that when triggers
checks required fields value is 0, if not then message box and end code
checks if the reference number already exists on a master tab, if the reference exisits, message box and end code
if 1 and 2 pass then perform a copy and paste as values for 3 ranges then message box.
I've tried a number of options but can't get it to work
Function Mand() As Boolean
'checks that mandatory fields have been updated
If Sheets("INPUT").Range("C11") > 0 Then MsgBox "Mandatory Fields Missing" & vbNewLine & "Changes Not Saved!"
Mand = True
End Function
Function RecEx() As Boolean
'checks that the reference number does not exisit on the High Level master list
dup = WorksheetFunction.CountIf(Sheets("High_Level_List").Columns(1), Sheets("INPUT").Range("C17"))
If dup > 0 Then MsgBox "This Record Exists!!!" & vbNewLine & "If saving an update, use the Save Changes button"
RecEx = True
End Function
Sub RegisterNewRec()
' checks 2 functions, if either are TRUE then exit, otherwise update master
If Mand Then Exit Sub
If RecEx Then Exit Sub
End If
Dim rng As Range
Set rng = Sheets("INPUT").Range("AO2:CX2")
Sheets("High_Level_List").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
'more code that updates master
MsgBox "Record added to Master"
End Sub
As I said in my comment, the End If doesn't need to be there:
If Mand Then Exit Sub
If RecEx Then Exit Sub
^ How the code should look
Alternatively you could use:
If Mand Or RecEx Then Exit Sub
You also need to make sure that you only set your function to True if the above is true by including the End If block:
Function Mand() As Boolean
If Sheets("INPUT").Range("C11") > 0 Then
MsgBox "Mandatory Fields Missing" & vbNewLine & "Changes Not Saved!"
Mand = True
End If
End Function
Function RecEx() As Boolean
dup = WorksheetFunction.CountIf(Sheets("High_Level_List").Columns(1), Sheets("INPUT").Range("C17"))
If dup > 0 Then
MsgBox "This Record Exists!!!" & vbNewLine & "If saving an update, use the Save Changes button"
RecEx = True
End If
End Function
The problem is that you were setting the RecEx and the Mand to true either way.
In my UserForm I have several frames, several OptionButtons and several TextBoxes. one example you can see in the screenshot.
Now I want that if I check the medium or high risk OptionButton the TextBox ("- Comment Risk -") should be mandatory and if it is empty or nothin was added an error message should be shown.
This is my macro so far:
Sub Comment_Check()
'obMedium = OptionButton "Medium"
'obHigh = OptionButton "High"
'txtRisk = TextBox "- Comment Risk -"
With UserForm1
For x = 1 to 6
If .Controls("obMedium" & x).Value = True Or .Controls("obHigh" & x).Value = True _
And .Controls("txtRisk" & x).Value = "" Or .Controls("txtRisk" & x).Value = "- Comment Risk -" Then
.Controls("txtRisk" & x).BackColor = RGB(255, 75, 80)
MsgBox "Error Message"
End If
Next
End With
End Sub
Now my problem is, if I check Medium and write something in the risk TextBox, the TextBox will be colored red and the error message is shown. If I check High and write something to the TextBox everything works fine.
What do I have to change that both ways will work.
The main issue is that you have to use parenthesis to group your Or & And satements logically.
Furthermore I suggest the following changes:
Write - Comment Risk - and - Comment Chance - into a Label control above the TextBoxes instead of writing it into the TextBox itself. So the user always can see which is which even when filled with data. Also the code would be easier.
Use a switch ErrorOccured that you turn True in your loop, otherwise you will get 6 error messages in a row (worst case).
Use Option Explicit and declare all your variables properly.
Something like the following should work.
Option Explicit
Sub Comment_Check()
Dim ErrorOccured As Boolean
With UserForm1
Dim x As Long
For x = 1 to 6
If (.Controls("obMedium" & x).Value Or .Controls("obHigh" & x).Value) _
And .Controls("txtRisk" & x).Value = vbNullString Then
.Controls("txtRisk" & x).BackColor = RGB(255, 75, 80)
ErrorOccured = True
End If
Next x
End With
If ErrorOccured Then
MsgBox "Error Message"
End If
End Sub
If you want to turn them non-red in a second run (eg. if you re-check after the user corrected his edit) then add a
ElseIf (.Controls("obMedium" & x).Value Or .Controls("obHigh" & x).Value) And .Controls("txtRisk" & x).Value <> vbNullString Then
.Controls("txtRisk" & x).BackColor = RGB(50, 168, 82) 'green
'don't set ErrorOccured to False here!
right before the End If line otherwise the box will stay red even if the user corrected his edit.