I use the following code to allow users to write a value into Cell A1.
Sub TestUsername()
If Environ("Username") = "firstname1.lastname1" Or Environ("Username") = "firstname2.lastname2" _
Or Environ("Username") = "firstname3.lastname3" Or Environ("Username") = "firstname4.lastname4" Then
Sheet1.Range("A1").Value = 1
Else
Sheet1.Range("A2").Value = 2
End If
End Sub
As you can see I list each user who is allowed to enter a value into Cell A1 with an OR-condition in my VBA code. All this works fine.
Now, I was wondering if there is an easier way to do this. Something like this:
Sub TestUsername()
If List of or-conditions: {"firstname1.lastname1", "firstname2.lastname2", _
"firstname3.lastname3", "firstname4.lastname4"} = True Then
Sheet1.Range("A1").Value = 1
Else
Sheet1.Range("A2").Value = 2
End If
End Sub
I just know in PHP you can compress multiple conditions like here. Therefore, I thought this might also be possible for VBA programming.
Maybe something like this
Sub TestUsername()
Select Case Environ("Username")
Case "firstname1.lastname1", "firstname2.lastname2", "firstname3.lastname3"
Sheet1.Range("A1").Value = 1
Case Else
Sheet1.Range("A2").Value = 2
End Select
End Sub
I suppose, if you had an atrocious amount of conditions, you could stick them in an array and then simply replace your conditional statement
If Environ("Username") = "firstname1.lastname1" Or Environ("Username") = "firstname2.lastname2" _
Or Environ("Username") = "firstname3.lastname3" Or Environ("Username") = "firstname4.lastname4" Then
with this
If IsInArray(Environ("Username"), arr) Then
This does require that you dimension an array with the conditions first and use this function, however:
Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim i
For i = LBound(arr) To UBound(arr)
If arr(i) = stringToBeFound Then
IsInArray = True
Exit Function
End If
Next i
IsInArray = False
End Function
This way, your code becomes much more readable and easy to maintain.
Since you're working in a cell, you might want to define the allowed usernames within the spreadsheet.
Here's how the spreadsheet table might look:
And here's the code you might use:
Sub TestUsername()
Dim username As String
Dim userInTable As Integer
Dim allowedUserRange As Excel.Range
username = Environ("username")
Set allowedUserRange = Excel.Range("tUsers")
userInTable = Excel.WorksheetFunction.CountIf(allowedUserRange, username)
If userInTable Then
Sheet1.Range("A1").Value = 1
Else
Sheet1.Range("A1").Value = 2
End If
End Sub
The Select Case provides a great solution to testing multiple conditions at the same time. I am using this to alert the user when they have not furnished all the required inputs. I am monitoring inputs from a number of Drop Down Boxes as well as some direct cell inputs.
Select Case True
Case Range("Customer_DD_Control_Cell") > 0 _
And Range("Dealer_DD_Control_Cell") > 0 _
And Range("Rep_DD_Control_Cell") > 0 _
And Range("Product_DD_Control_Cell") > 0 _
And Len(Range("Customer_State_Input")) > 0 _
And Len(Range("Contract_Date_Input")) > 0
Case Else
MsgBox "You have not completed the required inputs"
End Select
Related
I am trying to evaluate an expression only if a certain condition is met. The reason I am doing this is to allow the user to "lock" a value so that changes to other variables in the formula have no effect anymore.
I tried using the function below which works great until I close the sheet and open it again.
I already tried to use an additional cell passed as parameter to copy the value to it when it's not locked and copy it back if so however excel does not allow other cell modifications within a function.
Is there any way to achieve this functionality?
Function EvaluateIf(expression As String, condition As Boolean) As Variant
Application.Volatile
Dim myText As String
Dim myVal As Variant
If condition Then
myVal = Application.Evaluate(expression)
Else
myText = Application.Caller.Text
If IsNumeric(myText) Then
myVal = Val(myText)
Else
myVal = myText
End If
End If
EvaluateIf = myVal
End Function
EDIT1:
I need to apply this function onto multiple cells so I cannot hard code the cells
EDIT2:
I currently call the function like this in excel:
=EvaluateIf(N$7*IF(ISBLANK(P$7);1;P$7)*IF(ISBLANK(R$7);1;R$7);NOT(V$7))
Try this out - normal cautions apply to using this method to skirt around the restrictions applied to the use of UDF when called from a worksheet.
Function EvaluateIf(expression, condition As Boolean, backup As Range) As Variant
Dim myText As String
Dim myVal As Variant
Dim bak
bak = backup.Value
If condition Then
myVal = expression
If myVal <> bak Then 'update cached value?
Application.Evaluate "SetBackup(""" & backup.Parent.Name & """,""" & _
backup.Address & """,""" & myVal & """)"
End If
Else
myVal = bak
End If
EvaluateIf = myVal
End Function
Sub SetBackup(ws As String, addr As String, v)
Application.Calculation = xlCalculationManual 'avoid infinite loop!
ThisWorkbook.Sheets(ws).Range(addr).Value = v
Application.Calculation = xlCalculationAutomatic
End Sub
I'm trying to edit some objects texts with this:
' Textbox1
' Textbox2
' Textbox3
Sub Change_Text()
Dim i As Integer
For i = 1 To 3
UserForm1.Textbox & i = "Hi"
Next i
End Sub
I think the code explain my problem, of course it's returning an error, I don't have idea what to do...
You could do it like that
For i = 1 To 3
Controls("Textbox" & i) = "Hi"
Next i
Probably the optimal solution (least from your example) would be to loop over all the Textboxes
Private Sub loop_through_conts()
Dim cont as Control
For Each cont in Me.Controls
If TypeName(cont) = "Textbox" Then
Select Case Right(cont.Name, 1) ' in case you want only first three
Case 1 To 3
cont.Text = "Hi"
End Select
End If
Next cont
End Sub
This way your code is dynamic and does not have to be re-written in case a new Textbox were to be added
I have a list of names that I need to filter a pivot table on. I use a Case Select to make the pivot items that are equal to the names visible and all other not visible. Can I make a one time array or list of these 15 names and call the list/array name within the code instead of using the 15 names in multiple locations? I have to fun a pivot table and sort on these names many times.
This is what I am trying to avoid. It works as is, but I'm trying to save myself headaches in the future with modifications.
Set table = Worksheets("Sheet2").PivotTables("PivotTable2")
With table.PivotFields("Assigned to")
For Each PvI In .PivotItems
Select Case PvI.Name
Case "Antone", "Brad", "Cavan", "Chris", "Daneisha", "Edward", "James", "Jonathan", "Joesph", "Karen", "Shaun", "Steve", "Timothy", "Tracey"
PvI.Visible = True
Case Else
PvI.Visible = False
End Select
Next
End With
Try this REVERSE Select Case
Sub Sample()
Dim sNames As String
sNames = "/Antone/Brad/Cavan/Chris/Daneisha/Edward/James/Jonathan/Joesph/Karen/Shaun/Steve/Timothy/Tracey/"
Set Table = Worksheets("Sheet2").PivotTables("PivotTable2")
With Table.PivotFields("Assigned to")
For Each PvI In .PivotItems
Select Case 0 '<~~ Reverse Select case
Case InStr(1, sNames, "/" & PvI.Name & "/", vbTextCompare)
PvI.Visible = False '<~~ This also reverses
Case Else
PvI.Visible = True
End Select
Next
End With
End Sub
Here is a simple way to see how Reverse Select Case works :)
Sub Sample()
Dim sNames As String, NameToCheck As String
sNames = "/Antone/Brad/Cavan/Chris/Daneisha/Edward/James/Jonathan/Joesph/Karen/Shaun/Steve/Timothy/Tracey/"
NameToCheck = "Antoneeeee"
'NameToCheck = "Daneisha"
Select Case 0
Case InStr(1, sNames, "/" & NameToCheck & "/", vbTextCompare)
MsgBox "Not found"
Case Else
MsgBox " Found"
End Select
End Sub
Sure and it eliminates the Select Case. I tested the code below minus the pivot table aspect. This stores your names in an array. You can keep the array as a global variable or as a range in the workbook (for the latter change the nameArr = ... line). The code (UBound(Filter(nameArr, PvI.Name)) > -1) will check if PvI.Name exists in nameArr by filtering the array for your desired name and checking if the resulting array has anything in it. Then the true/false value returned by the "array contains check" is assigned to PvI.Visible.
Dim nameArr As Variant
nameArr = Array("Antone", "Brad", "Cavan", "Chris", "Daneisha", "Edward", "James", "Jonathan", "Joesph", "Karen", "Shaun", "Steve", "Timothy", "Tracey")
Set table = Worksheets("Sheet2").PivotTables("PivotTable2")
With table.PivotFields("Assigned to")
For Each PvI In .PivotItems
PvI.Visible = (UBound(Filter(nameArr, PvI.Name)) > -1)
Next
End With
Elaborating on my comment, I recommend a table-driven approach.
The first thing to do is put the names of interest in a worksheet, and give that range a name. I called the range "MyNames" in this example.
The second thing to do is add this function to your project:
Function NameIsInList(LookFor As String) As Boolean
On Error GoTo Err_NameIsInList
NameIsInList = WorksheetFunction.Match(LookFor, Range("MyNames"), 0) > 0
On Error GoTo 0
Exit Function
Err_NameIsInList:
' the name was not found, or a bad parameter was supplied
NameIsInList = False
On Error GoTo 0
End Function
Finally, modify your procedure to use the function:
Set table = Worksheets("Sheet2").PivotTables("PivotTable2")
With table.PivotFields("Assigned to")
For Each PvI In .PivotItems
PvI.Visible = NameIsInList(PvI.Name)
Next
End With
The advantages I was shooting for here are:
Table-driven: The list of values can be stored in a worksheet where it's easily accessible and modified. (If you don't want users to see the LOV you can always hide the worksheet.)
Reusable: Let the function do the work of checking the name list. You suggest this is something that needs to be done many times; the function can be called from multiple places.
I want to filter a pre-determined column using a query from a user (Input Box)
Ex: Filter column "L" with a user input text "Joey".
Can anyone guide me as to what needs to be done? This is the code I was trying...
Set wSheetStart = ActiveSheet
Set rFilterHeads = Range("L1", Range("IV1").End(xlToLeft))
With wSheetStart
.AutoFilterMode = False
rFilterHeads.AutoFilter
strCriteria = InputBox("Enter Criteria")
If strCriteria = vbNullString Then Exit Sub
rFilterHeads.AutoFilter Field:=3, Criteria1:=strCriteria
End With
Use a loop + Like to limit entry to whatever you need.
Do
strCriteria = UCase(InputBox("Enter criteria"))
Loop Until Len(strCriteria) = 0 Or strCriteria Like "?????"
If Len(strCriteria) = 0 Then Exit Sub
'continue...
I'm programming a Makro for a Excel xy-Diagramm
The diagramm is nearly correct, but i have dublicate DataSeriesNames;
I already tried to go through all Series and Compare the Names.
There were no Errors, but it didn't work.
Code was like that:
For a=1 to Count
If ActiveChart.SeriesCollection(Count).Name = Range("A2").Value Then
Name = true
End If
a = a + 1
Next
If Name = false Then
ActiveChart.SeriesCollection.NewSeries
End If
ActiveChart.SeriesCollection(Count).Name = "='Tasks'!$D$" & i
ActiveChart.SeriesCollection(Count).XValues = "='Tasks'!$B$" & i
ActiveChart.SeriesCollection(Count).Values = "='Tasks'!$C$" & i
Mfg Robin
There are a couple of things wrong here.
First of all, you're always looking at the same series! I think you want to replace Count with a in your If statement.
If ActiveChart.SeriesCollection(a).Name
Secondly, once that is corrected, even if your Name variable gets set to True at some point, it may get reset to False later as the For...Next loop continues iterating through the remainder of the series collection. To prevent this, add an Exit For like this:
For a = 1 To Count
If ActiveChart.SeriesCollection(a).Name = Range("A2").Value Then
Name = True
Exit For
End If
a = a + 1
Next
Also, I suspect you haven't declaring Name as a Boolean variable, so by default it's a Variant so its value isn't False to start with! You should declare the variable at the top of your procedure with Dim Name as Boolean, and then if you want Name to be False by default, you should really say so explicitly: Put Name = False before the loop. Moreover, Name is a terrible name for a variable... and so is Count Argh! I think your code should look like this:
Option Explicit
Sub MySub()
Dim a As Long
Dim NameExists As Boolean
Dim SeriesCount As Long
SeriesCount = ActiveChart.SeriesCollection.Count
NameExists = False
For a = 1 To SeriesCount
If ActiveChart.SeriesCollection(a).Name = Range("A2").Value Then
NameExists = True
Exit For
End If
a = a + 1
Next
If NameExists = False Then
' Rest of your code goes here...
End Sub