I would like to have a multiple selection choise from a dropdown for multiple columns on one Excel sheet. I found a code for a multiple selection from a dropdown in one column per sheet, but i need five.
The Code it self works for one column.
I already tried to name the Worksheet_Changes in
Worksheet_Changes1
Worksheet_Changes2
that didn't work. The result is that I can't choose multiple Names for one cell from a dropdown
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim wert_old As String
Dim wertnew As String
On Error GoTo Errorhandling
If Not Application.Intersect(Target, Range("B4:B999")) Is Nothing Then
Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
If rngDV Is Nothing Then GoTo Errorhandling
If Not Application.Intersect(Target, rngDV) Is Nothing Then
Application.EnableEvents = False
wertnew = Target.Value
Application.Undo
wertold = Target.Value
Target.Value = wertnew
If wertold <> "" Then
If wertnew <> "" Then
Target.Value = wertold & ", " & wertnew
End If
End If
End If
Application.EnableEvents = True
End If
In the end I would like to select multiple names form a dropdown selection, in five different columns
If Not Application.Intersect(Target, Range("B4:B999")) Is Nothing Then
If Not Application.Intersect(Target, Range("C4:C999")) Is Nothing Then
If Not Application.Intersect(Target, Range("D4:B999")) Is Nothing Then
...
...
...
Use the Application.Union method to combine the ranges you want to run the code in. And then Intersect them with Target like:
If Not Application.Intersect(Target, Union(Me.Range("B4:B999"), Me.Range("C4:C999"), Me.Range("D4:B999"))) Is Nothing Then
Related
In a cell, I have made a list to choose. However, one choice is not enough. I found some vba code that enables me to make more choices. But this code points to a specific cell. I want to use it more general in the sheet, probably a range.
I tried to put in a range as target.address but that won't work. It won't work with a range of one cell (J3) either. I found out that the formula below does not work after removing the dollar signs from $j$3.
Dim Oldvalue As String
Dim Newvalue As String
On Error GoTo Exitsub
TheCell = ActiveCell
If Target.Address = "$J$13" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
Target.Value = Oldvalue & ", " & Newvalue
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
I look for a solution to choose from all the list of more than one item. The formula should be changed in a way that is usable in a range of cells. These cells have al the same choice list.
Instead of
If Target.Address = "$J$13" Then
You can do an Intersect of your Target range with the range you like to check:
Dim AffectedRange As Range
Set AffectedRange = Intersect(Target, Me.Range("J13:J20")) 'put your range here
If Not AffectedRange Is Nothing Then
Dim Cell As Range
For Each Cell In AffectedRange 'loop through all affected cells
'here use Cell instead of Target
Next Cell
End If
I have a column named "time" in my excel sheet. I want to write a code such that whenever user performs an entry in time column, if it is a whole number, it should accept, but if it is not a pop up should appear saying "only numbers allowed". Also, the validation should be dynamic i.e. should automatically validate next row if users enters a new entry
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = Range("Meeting Time").Column Then
If Not (IsNumeric(Target.Value)) Then
MsgBox "only numbers allowed"
Target.Value = ""
Target.Select
End If
End If
End Sub
You could try:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'1. Check if the column that affected is B (change to the column you want)
'2. Check if changed field is one (used to avoid errors if user change more than one cells at the same time)
If Not Intersect(Target, Columns("B:B")) Is Nothing And Target.Count = 1 Then
'Check if target is numeric
If Not IsNumeric(Target.Value) Then
Call Clear(Target)
End If
'Check if target.offset(1,0) is numeric
If Not IsNumeric(Target.Offset(1, 0).Value) Then
Call Clear(Target.Offset(1, 0))
End If
End If
End Sub
Sub Clear(ByVal rng As Range)
'Disable events in order to prevent code to re trigger when clear cell
Application.EnableEvents = False
rng.Value = ""
'Enable events
Application.EnableEvents = True
End Sub
EDITED VERSION:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'1. Check if the column that affected is B (change to the column you want)
'2. Check if changed field is one (used to avoid errors if user change more than one cells at the same time)
If Not Intersect(Target, Columns("B:B")) Is Nothing And Target.Count = 1 Then
'Check if target is numeric
If Not IsNumeric(Target.Value) Then
Call Clear(Target)
ElseIf Target.Value > 160 Or (Target.Value = Int(Target.Value) = False) Then
Call Clear(Target)
End If
'Check if target.offset(1,0) is numeric
If Not IsNumeric(Target.Offset(1, 0).Value) Then
Call Clear(Target.Offset(1, 0))
ElseIf Target.Offset(1, 0).Value > 160 Or (Target.Offset(1, 0).Value = Int(Target.Offset(1, 0).Value) = False) Then
Call Clear(Target)
End If
End If
End Sub
Sub Clear(ByVal rng As Range)
'Disable events in order to prevent code to re trigger when clear cell
Application.EnableEvents = False
rng.Value = ""
'Enable events
Application.EnableEvents = True
End Sub
first you can create a range name for column you want your "time" and you can use the sample codes below.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = Range("time").Column Then
If Not (IsNumeric(Target.Value)) Then
MsgBox "only numbers allowed"
Target.Value = ""
Target.Select
End If
End If
End Sub
I need to reference an entire column of Excel spreadsheet, with a drop-down list using VBA. The code i got online works only for a single cell which is "$M$2". How can i define a range for the entire column?
Private Sub Worksheet_Change(ByVal Target As Range)
' To Select Multiple Items from a Drop Down List in Excel
Dim Oldvalue As String
Dim Newvalue As String
On Error GoTo Exitsub
If Target.Address = "$M$2" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
Target.Value = Oldvalue & ", " & Newvalue
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
Firstly, Target may be a single cell or multiple cells, depending on what the user changed
To test if any cell in (and only in) column M changed, use
If Target.EntireColumn.Address = "$M:$M" Then
To test if any cell in Target is in column M use
Dim rng As Range
Set rng = Application.Intersect(Target, Me.Columns("M"))
If Not rng Is Nothing Then
Note: the rest of your code will need to be modified to allow for Target being more than one cell
I have been looking for days to solve this and have only come up with half the solution.
What I can do:
I would simply like to have one cell turn green inside with an x inserted when another cells data has the word "Complete" inside it.
What I cannot do:
I would like that same cell that turned green with an x inserted into it when the word "Complete" is changed to "Rework" to stay green with an x.
So Cell A1 is blank then in cell B1 the word "Complete" is added. Then cell A1 changes to green and has an x inside it. If later B1 changes to "Rework" I would like A1 to stay green with the x inside. So I can know that at one time the status of B1 was at one time "Complete"
I have been trying Conditional Formatting with rules but cannot get it to stay. I think the "Stop If True" check box within would be part of the solution but not sure what the code would be.
I already have a different macro running on this sheet so if the answer is a macro I will need it to be added to it. Below is the macro in the sheet already. Thank you.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("N:N,Y:Y"), Range("10:" & Rows.Count)) Is Nothing Then
If Target.Count < Columns.Count Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim r As Range
For Each r In Intersect(Target, Range("N:N,Y:Y"), Range("10:" & Rows.Count))
With r.Offset(0, 1)
.Value = Now 'use Now to retain the time as well as the date
.NumberFormat = "mm/dd/yy" 'change to what you prefer
End With
Next r
End If
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
Ideally you'd split this up into separate subs to handle each of the change types, but this should give you an idea:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r as Range
'skip full-row changes (row insert/delete?)
If Target.Columns.Count = Columns.Count Then Exit Sub
Set rng = Intersect(Target, Range("N:N,Y:Y"), Range("10:" & Rows.Count))
If Not rng Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
For Each r In rng.Cells
With r.Offset(0, 1)
.Value = Now 'use Now to retain the time as well as the date
.NumberFormat = "mm/dd/yy" 'change to what you prefer
End With
Next r
End If
Set rng = Intersect(Target, Range("B:B"), Range("10:" & Rows.Count))
If Not rng Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
For Each r In rng.Cells
If r.Value = "Complete" Then
With r.Offset(0, -1)
.Value = "x"
.Interior.Color = vbGreen
End With '<<EDIT thanks #BruceWayne
End If
Next r
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
You'll need two worksheet events, and some If statements. The following should help you get started, unless I'm overlooking something.
Dim oldVal as String ' Public variable
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Debug.Print Target.Address
If Target.Cells.Count <> 1 Then Exit Sub
oldVal = Target.Value
End Sub
The above will make note of the oldValue.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim newVal As String
newVal = Target.Value
If newVal = oldVal Then
Debug.Print "Same Values"
ElseIf oldVal = "Complete" And newVal = "Rework" Then
Debug.Print "Stay green with X"
ElseIf oldVal = "" And (newVal = "Complete" Or newVal = "complete") Then
Debug.Print "Change cell to Green, add an 'X'"
Target.Interior.ColorIndex = 10
Target.Value = Target.Value & " x"
End If
End Sub
Then, add/tweak those If statements as necessary, and add the color changing/reverting code to the appropriate block.
(There may of course be a better mousetrap, but I think this should get you going).
I have two tables. Both tables are the same size, located in columns I:X and AB:AQ (offset by 19 columns start-to-start).
I want when I enter a number in a cell within the left table, to go 19 columns to the right after pressing enter. Then, once entering text into the active cell in the right table, return 19 cells to the left table.
I found this question/answer, but I wasn't able to apply it.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not Target.Cells.CountLarge > 1 Then
If Not Intersect(Target, Columns(9)) Is Nothing Then
Target.Offset(, 19).Select
ElseIf Not Intersect(Target, Columns(10)) Is Nothing Then
Target.Offset(, 19).Select
ElseIf Not Intersect(Target, Columns(11)) Is Nothing Then
Target.Offset(, 19).Select
ElseIf Not Intersect(Target, Columns(12)) Is Nothing Then
Target.Offset(, 19).Select
'etc...
ElseIf Not Intersect(Target, Columns(42)) Is Nothing Then
Target.Offset(, -19).Select
ElseIf Not Intersect(Target, Columns(43)) Is Nothing Then
Target.Offset(, -19).Select
End If
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
As an alternative, if it can recognize that the cell entered is within columns I:X and just offset 19 columns after pressing enter (and then the reverse), this would be fine.
A second alternative, if it is easier, changing the function of the Page Up and Page Down keys, I would not need to check which column I am in.
Lastly, this should only work on a particular sheet Tracking.
Something like this should work for you. Make sure the code is in the 'Tracking' worksheet code module:
And here is the code you would use:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngChange1 As Range
Dim rngChange2 As Range
Set rngChange1 = Range("I:X")
Set rngChange2 = Range("AB:AQ")
Application.EnableEvents = False
If Not Intersect(rngChange1, Target) Is Nothing Then
Target.Offset(, 19).Value = Target.Value
End If
If Not Intersect(rngChange2, Target) Is Nothing Then
Target.Offset(, -19).Value = Target.Value
End If
Application.EnableEvents = True
End Sub