I am trying to write a macro for multiple drop-downs in "n" cells (let's say 100) in a column. The ranges(drop-down values) for these drop-downs have to be picked from a table with same number of rows (100 in our case).
I am unable to run the for loop for the formula part (highlighted below). I want the macro to pick D2:H2 range for i=2, D3:H3 for i=3, and so on. How do I do it? Is there any alternative to this?
Looking forward to valuable inputs.
Thanks!!
Sub S_Dropdown3()
Dim wks As Worksheet: Set wks = Sheets("Sheet1")
wks.Select
Dim i As Integer
For i = 2 To 101
With Range("B" & i).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, **Formula1:="=Sheet2!D2:H2"**
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Next i
End Sub
The following code should work:
Option Explicit
Sub S_Dropdown3()
Dim wks As Worksheet
Dim i As Integer
Set wks = ThisWorkbook.Worksheets("Sheet1")
wks.Activate
For i = 2 To 101
With wks.Range("B" & i).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Sheet2!D" & i & ":H" & i
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Next i
End Sub
Implemented changes:
Code formatting / indentation
Implementing full qualification to ensure that Sheet1 refers to Sheet1 in the workbook from which the macro is run (in case that more than one Excel file is open).
Sheets cannot be .Selected only ranges get selected. Sheets can only be .Activated. Earlier versions of Excel don't mind. Never versions of Excel will throw an error with that line.
Fully qualifying .Range("B" & i).
Finally, making the formula modular as requested in the initial post.
Related
I'm trying to replace all cells in a column with a dropdown list for using an excel macro. I'm also trying to use dynamic range as I don't know how long the list is at all times. This is my code as of right now:
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("*Name of main sheet*")
Set StartCell = Range("A1")
'Find Last Row and Column
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
'Select Range
Worksheets("*Name of main sheet*").Activate
'replace "J2" with the cell you want to insert the drop down list
With Range(StartCell, sht.Cells(LastRow, LastColumn))
.Delete
'replace "=A1:A6" with the range the data is in.
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:="=Sheet1!A1:A6"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
I'm creating the lists with all the options for the drop down in a separate tab called Sheet1.
add .Validation at the end of With Range(StartCell, sht.Cells(LastRow, LastColumn)) and use $ to keep rows reference fixed
so the whole With-End block With becomes:
With Range(StartCell, sht.Cells(LastRow, LastColumn)).Validation
.Delete
'replace "=A1:A6" with the range the data is in.
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:="=Sheet1!A$1:A$6"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
if you need to keep dropdowns list dynamic with Sheet1 column A not blank values then you could go as follows:
Dim LastRow As Long
Dim LastColumn As Long
Dim sourceSht As Worksheet
Set sourceSht = Worksheets("Sheet1")
With Worksheets("Name of main sheet")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).row
LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
With .Range("A1", .Cells(LastRow, LastColumn)).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:="=" & sourceSht.name & "!" & sourceSht.Range("A1", sourceSht.Cells(sourceSht.Rows.Count, 1).End(xlUp)).Address(True, False)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End With
My plan is to enter data on a specific sheet(List) and automatically sort by alphabetical order, then create a data validation on the first sheet (TicketSheet).
When I enter any date and save I can't open the file again because it crashes.
I developed the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("$A:$F")) Is Nothing Then
Dim x As Range
Set x = Cells(2, Target.Column)
Dim y As Range
Set y = Cells(1000, Target.Column)
If Target.Column = 1 Or Target.Column = 4 Or Target.Column = 6 Then
Range(x, y).Sort Key1:=Target, Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End If
Call AddData
Call AddData1
Call AddData2
End Sub
Sub AddData()
Dim Lrow As Single
Dim Selct As String
Dim Value As Variant
Lrow = Worksheets("List").Range("A" & Rows.Count).End(xlUp).Row
For Each Value In Range("A2:A" & Lrow)
Selct = Selct & "," & Value
Next Value
Selct = Right(Selct, Len(Selct) - 1)
With Worksheets("TicketSheet").Range("C4").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Selct
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
Sub AddData1()
Dim Lrow1 As Single
Dim Selct1 As String
Dim Value As Variant
Lrow1 = Worksheets("List").Range("D" & Rows.Count).End(xlUp).Row
For Each Value In Range("D2:D" & Lrow1)
Selct1 = Selct1 & "," & Value
Next Value
Selct1 = Right(Selct1, Len(Selct1) - 1)
With Worksheets("TicketSheet").Range("C3").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Selct1
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
Sub AddData2()
Dim Lrow2 As Single
Dim Selct2 As String
Dim Value As Variant
Lrow2 = Worksheets("List").Range("F" & Rows.Count).End(xlUp).Row
For Each Value In Range("F2:F" & Lrow2)
Selct2 = Selct2 & "," & Value
Next Value
Selct2 = Right(Selct2, Len(Selct2) - 1)
With Worksheets("TicketSheet").Range("C5").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Selct2
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub]
First off, you need to disable events. The Worksheet_Change event macro is triggered by a change of values. If you are going to start changing values inside a Worksheet_Change then disabling events stops the macro from triggering itself.
Additionally, the Target is the cell or cells that have been changed. Your code does not allow for the latter; it only deals with situations where Target is a single cell. For the time being, discard large changes (like those in a row deletion or sort operation).
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("$A:$F")) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim x As Range, y As Range
Set x = Cells(2, Target.Column)
Set y = Cells(1000, Target.Column)
If Target.Column = 1 Or Target.Column = 4 Or Target.Column = 6 Then
'you really should know if you have column header labels or not
Range(x, y).Sort Key1:=Target, Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Call AddData
Call AddData1
Call AddData2
End If
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
That should get you started. I will look deeper into your other sub procedures later but I will remark that it seems like you have an awful lot going on to have initiated by a Worksheet_Change.
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.
Am quite new to VBA and am piecing together my developments one step at at time searching for answers online but have hit a snag.
I'm struggling to understand how the creation of the data validation list code works. The beginning "With WrkBook.Range("H3").Validation" is where I'm putting the drop down list? Seems 'yes' from one posting, but another seemed to have the "With" followed by the actual range which contains the list. Secondly, the "Formula1:=..." I believe is also the location of the list. However, I seem to be only able to include the first cell in my list as being included in the list. Thanks in advance for any help.
Dim WrkBook As Worksheet
Dim LastCellRowNumber As Integer
Dim ListRng As Range
Dim Rng As Range
Set WrkBook = Worksheets("Misc Ref")
'Find
WrkBook.Activate
Range("A100000").Select
Range(Selection, Selection.End(xlUp)).Select
LastCellRowNumber = ActiveCell.Row
ActiveSheet.Cells(LastCellRowNumber, 1).Select
Set ListRng = WrkBook.Range(Cells(2, 1), Cells(LastCellRowNumber, 1))
With WrkBook.Range("H3").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=WrkBook.ListRng
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
In this line:
Set ListRng = WrkBook.Range(Cells(2, 1), Cells(LastCellRowNumber, 1))
you already set or assign a Range Object referenced at WrkBook sheet object.
So you don't have to use WrkBook.ListRng in assigning the Formula1 argument.
Also, Formula1 argument is suppose to be the address of the source range in the form of string.
So it should be something like:
Formula1:= "=" & ListRng.Address
This will fail though if the worksheet your putting the validation list is not the same worksheet of the source list. So you might want to add:
Formula1:= "=" & ListRng.Address(, , xlA1, True)
That will give you the Sheet name as well. HTH.
Edit2: Based on comments and no need to use Split function.
Sub test()
Dim r As Range, lrow As Long
With Sheets("Misc Ref")
lrow = .Range("A" & .Rows.Count).End(xlUp).Row
Set r = .Range("A2:A" & lrow)
End With
'Debug.Print "=" & r.Address(, , xlA1, True)
With Sheets("Summary").Range("H10").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=" & r.Address(, , xlA1, True)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
Setting the Address property External argument to True includes the full path.
But if you assign it to a validation formula, it automatically disregards the Workbook name.
So there is no need to use Split Function. No need to worry the apostrophe then. HTH.
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.