Data validation based on cell value - vba

I am adding a data validation list based on a cell value. If value in cell B29 = "text1" then add data validation in cell D29. If the cell B29 has a different value then a formula has to be added to cell D29 and the data validation has to be removed.
Here is an example of the macro:
If Range("B29").Value = "Text1" Then
Range("D29").Value = ""
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(B29)"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
ElseIf Range("B29").Value = "Value1" Then
Range("D29").Formula = "=IF(Sheet2!B9,VLOOKUP(Sheet2!B8,'Team Target Tabel'!C2:E17,2,FALSE),"""")"
Range("D29").Validation.Delete
ElseIf Range("B29").Value = "Value2" Then
Range("D29").Formula = "=IF(Sheet2!B9,VLOOKUP(Sheet2!B8,'Team Target Tabel'!C2:E17,2,FALSE),"""")"
Range("D29").Validation.Delete
ElseIf Range("B29").Value = "Value3" Then
Range("D29").Formula = "=IF(Sheet2!B9,VLOOKUP(Sheet2!B8,'Team Target Tabel'!C2:E17,2,FALSE),"""")"
Range("D29").Validation.Delete
End If
End Sub
Cell B29 is also a data validation cell which has 4 values. If the value is text1 then cell D29 has to change into a data validation list but I have to run the macro manually to do this. When D29 is a data validation list and I change the value in cell B29 I have to run the macro again (manually) to change it back to the formula.

You could capture the Worksheet_change event to re-run the macro when D29 changes.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("B29")) Is Nothing Then
Call myMacroToChangeValidationOfD29
End If
End Sub
BTW, why With Selection.Validation not With Range("D29").Validation ??

I would use StrComp to compare strings, example:
If StrComp(Range("B29").Value, "text1") = 0 Then
'Something
End If
You want to check B29 against "text1", however, you are checking it against "Text1". You might have a problem of case sensitivity. Your else cases are similar, you could simplify them to a single else, like this:
If StrComp(Range("B29").Value, "text1") = 0 Then
Range("D29").Value = ""
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=INDIRECT(B29)"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Else
Range("D29").Formula = "=IF(Sheet2!B9,VLOOKUP(Sheet2!B8,'Team Target Tabel'!C2:E17,2,FALSE),"""")"
Range("D29").Validation.Delete
End Sub

Related

VBA - Change Formula dynamically

I have an drop-down validating formuala for a cell and am using the generic formula inside the validation in vba.
Now, I want to automate it using the formula1 part inside the with loop here.
Here goes the Code,
Lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
Lastrow2 = Sheets("Config").Cells(Rows.Count, "R").End(xlUp).Row
For i = 2 To Lastrow
With Range("M" & i).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:="=Config!R2:R10"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Next
how would you replace the part in the code - Formula1:="=Config!R2:R10" with the 10 being Lastrow2.
Thanks
The solution :
Formula1:="=Config!R2:R"&Lastrow2

Create a dropdown list when a row is added using VBA

I want to write a macro that does as follows:
If you enter a value under column A, it gives a dropdown list in the same row under column B.
I have written a peice which works for the first time. But the problem is when I run it, if there is already a dropdown list in some cells, it breaks!
Sub Macro2()
Dim cell As Range
'If a value is listed
For Each cell In ActiveSheet.Range("A2:A1000")
If cell.Value <> "" Then
cell.Offset(0, 1).Select
If Selection = Empty Then
With Selection.Validation
'add list box
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Sheet1!A2:A20"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End If
Next cell
End Sub
I should add that I cannot delete the content in column B, because I do not want to lose the work already there.
Here's a solution that will just delete a validation, then add back. Also, I removed the use of .Select, which can cause errors.
Dim isValid As Boolean
Sub Macro2()
Dim cell As Range
'If a value is listed
For Each cell In ActiveSheet.Range("A2:A1000")
If cell.Value <> "" Then
testIfValidation cell.Offset(0, 1)
If IsEmpty(cell.Offset(0, 1)) And Not isValid Then
With cell.Offset(0, 1).Validation
'add list box
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Sheet1!A2:A20"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End If
Next cell
End Sub
Private Sub testIfValidation(ByVal cel As Range)
Dim X As Variant
On Error Resume Next
X = cel.Validation.Type
On Error GoTo 0
If IsEmpty(X) Then
Debug.Print cel.Address & " has no validation"
isValid = False
Else
isValid = True
End If
End Sub
I updated this with a test to see if a cell has validation. If it does, it'll skip it. Otherwise, proceed as usual.
Why don't you clear existing data validation before adding the new one?
Along these lines:
With Selection.Validation
' delete existing
.Delete
'add list box
.Add Type etc.
The Validation.Delete does the same thing as clicking "Clear All" in the data validation dialog. No cell content gets changed or removed.

Specify Range of cells for .validation

I would like to insert a data validation list that grabs data from another sheet. the column the list will be generated from is stored in another variable that is dynamic. My code so far is:
pRange = Sheets("Payer Output").Cells(24, 3).Value
With Sheets("Payer Output").Range("C23").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=Sheets("Payers in Top 4").Cells(3, pRange)
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
This formula generates a list, and looks in the correct column, however the current code only specifies the list should look in a single cell, so when the list is generated, there is only one value. How do I specify a range of cells for the 'formula1:=' line? I've tried:
Formula1:=Sheets("Payers in Top 4").Range(Cells(3, pRange), Cells(10,pRange))
But this does not work. Thank you for your help!
Sometimes I will just name the range and put the named range in the list.
Sub AddDtaVal()
pRange = Sheets("Payer Output").Range("C24").Value
Sheets("Payers in Top 4").Range(Sheets("Payers in Top 4").Cells(3, pRange), Sheets("Payers in Top 4").Cells(10, pRange)).Name = "List"
With Sheets("Payer Output").Range("C23").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=List"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
You need to build the address formula in a string, Excel-style : 'Sheet Name'!A1:A10
Dim StrFormula As String
Dim pRange As Long
pRange = Sheets("Payer Output").Cells(24, 3).Value
With Sheets("Payers in Top 4")
StrFormula = "'" & .Name & "'!" & .Range(.Cells(3, pRange), .Cells(10, pRange)).Address
End With
With Sheets("Payer Output").Range("C23").Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:=StrFormula
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Try this
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:="='Payers in Top 4'!" & Worksheets("Payers in Top 4").Cells(3, pRange).Resize(8).Address

VBA Create a validation based on the first character of the entry into a cell

Hi I am trying to create a cell validation in Excel through VBA. I am trying to do this through use of a wild card so that the validation in that cell will be based of the first character in the data entry.
Here is the Code I am working with.
Dim wild1 as string
wild1 = Cells(11, 7) Like "b*"
With Cells(11, 7).Validation
.Delete
.Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Formula1:=wild1
End With
With the code above I get a validation error every time I try to type something into Cell(11, 7). How would I change this so that the data entry would be valid if the first character in the data entry in that cell starts with a b?
Thanks!
This is based on simoco's comment.........this event code goes in the worksheet code area:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ch As String
If Intersect(Target, Cells(11, 7)) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
ch = Left(Target, 1)
dq = Chr(34)
With Target.Validation
.Delete
.Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=left(A1,1)=" & dq & ch & dq
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Application.EnableEvents = False
End Sub
and assumes G7 starts with no validation. Once a value is entered, the first letter is used in the validation.

VBA controlling user focus during iteration

quick question that shouldn't really require any of my code. During my application, I use a 'for each' loop, that loops through a range of cells, and right now when the user runs it, the focus of the screen follows the selection as it jumps from cell to cell within that range. Is there any way to prevent the focus from following the path of the loop during the iteration, maybe have the user simply see something that says "processing" until it is complete?
Thanks in advance, I appreciate any and all help.
Code:
Dim iLoop As Integer
For iLoop = 5 To lastRow
Sheets("Planners").Activate
Range("J" & iLoop).Select
Range(Cells(iLoop, 9)).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="Yellow, Orange, Green, Red"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = "Invalid Entry"
.ErrorMessage = "Please choose from dropdown"
.ShowInput = True
.ShowError = True
End With
Next iLoop
Apparently you are using .Select in your code. There is a chance it's a right thing to do, but most of the time it isn't.
So stop using Select and ActiveCell and refer to cells using indices/references.
The above would be the correct solution.
The wrong solution would be to use Application.ScreenUpdating = False before the loop and Application.ScreenUpdating = True after the loop.
Edit:
Dim iLoop As long
dim w as worksheet
set w = Worksheets("Planners")
For iLoop = 5 To lastRow
With w.cells(iLoop, 9).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="Yellow, Orange, Green, Red"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = "Invalid Entry"
.ErrorMessage = "Please choose from dropdown"
.ShowInput = True
.ShowError = True
End With
Next
But given this code, you don't need a loop at all:
dim w as worksheet
set w = Worksheets("Planners")
With w.Range(w.cells(5, 9), w.cells(lastRow, 9)).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="Yellow, Orange, Green, Red"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = "Invalid Entry"
.ErrorMessage = "Please choose from dropdown"
.ShowInput = True
.ShowError = True
End With
All you need to do is add application.screenupdating = false at the start of you code (after the sub definition of course) and application.screenupdating = true at the end before 'end sub'.
It's good practice to add this to all your sub and functions as it will make them run faster as well.