I would appreciate some assistance with a problem i am having. The following code sample allows me to select multiple values from a dropdown list however i need the target.address to be every row within column S.
I am unsure how to change the target address so that it is the range s10 onwards (ie S10-S150)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
On Error GoTo Exitsub
If Target.Address = "$S10" 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
Thank you!
You can test to see if the affected range is within another range like this:
If Not Intersect(Target, Range("S10:S150")) Is Nothing Then
The line above would replace this line in your original code:
If Target.Address = "$S10" Then
Related
I have basic code that allows the values written to this cell to be summed while maintaining the cumulative value. So if I were to type "4" into the cell, and then type "10" into the cell, the result would be "14" (not just the second value entered of "10"). Here is what I have and I must say that it works.
#
Option Explicit
Dim oldvalue As Double
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$J$5" Then
On Error GoTo fixit
Application.EnableEvents = False
If Target.Value = 0 Then oldvalue = 0
Target.Value = 1 * Target.Value + oldvalue
oldvalue = Target.Value
fixit:
Application.EnableEvents = True
End If
End Sub
#
However, I want to apply this treatment to more than just cell J5. Say for example, I want the same code logic applied to cell R5 as well.
Thur far I have tried using
OR
and I have also tried using
If Not Intersect (Target, Range("J5:R5")) Is Nothing Then
But each of these approaches ties the two cells together (so that what I enter into one gets summed into both - each cell is summing values added to the other). I can't figure it out to save my life, so took to this forum in the hopes of finding someone smarter than me.
Maybe (this is assuming existing logic is correct....not sure why you set old value to 0 if Target = 0 and what value the *1 adds?)
Option Explicit
Dim oldvalueJ As Double
Dim oldValueR As Double
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo fixit
Application.EnableEvents = False
Select Case Target.Address
Case "$J$5"
If Target = 0 Then oldvalueJ = 0
Target = Target + oldvalueJ
oldvalueJ = Target
Case "$R$5"
If Target = 0 Then oldValueR = 0
Target = Target + oldValueR
oldValueR = Target
End Select
fixit:
Application.EnableEvents = True
End Sub
This is a bit more dynamic by allowing you to add unlimited cells; it also validates user input
Standard Module
Option Explicit 'Generic Module
Public Const WS1_MEM_RNG = "C5,J5,R5" 'Sheet1 memory cells
Public prevWs1Vals As Object
Public Sub SetPreviousWS1Vals()
Dim c As Range
For Each c In Sheet1.Range(WS1_MEM_RNG).Cells
If Len(c.Value2) > 0 Then prevWs1Vals(c.Address) = c.Value2
Next
End Sub
Sheet1 Module
Option Explicit 'Sheet1 Module
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.CountLarge = 1 Then
If Not Intersect(Target, Me.Range(WS1_MEM_RNG)) Is Nothing Then GetPrevious Target
End If
End Sub
Private Sub GetPrevious(ByVal cel As Range)
Dim adr As String: adr = cel.Address
Application.EnableEvents = False
If Not IsError(cel.Value) And IsNumeric(cel.Value2) And Not IsNull(cel.Value) Then
If IsDate(cel.Value) Then
cel.NumberFormat = "General"
cel.Value2 = prevWs1Vals(adr)
Else
If cel.Value2 = 0 Then prevWs1Vals(adr) = 0
cel.Value2 = cel.Value2 + prevWs1Vals(adr)
prevWs1Vals(adr) = cel.Value2
End If
Else
cel.Value2 = prevWs1Vals(adr)
End If
Application.EnableEvents = True
End Sub
ThisWorkbook Module
Option Explicit 'ThisWorkbook Module
Private Sub Workbook_Open()
If prevWs1Vals Is Nothing Then Set prevWs1Vals = CreateObject("Scripting.Dictionary")
SetPreviousWS1Vals
End Sub
It can also enforce positives only
use commas to separate ranges, and add a Worksheet_SelectionChange() event to record the last user selected cell
Option Explicit
Dim oldvalue As String
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Intersect(Target, Range("J5,R5")) Is Nothing Then Exit Sub
If Target.Value = 0 Then Exit Sub
On Error GoTo fixit
Application.EnableEvents = False
Target.Value = Target.Value + oldvalue
fixit:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge = 1 Then oldvalue = Target.Value
End Sub
I am trying to vlookup multiple values in one cell based on the a selection from another cell.
I have the below table where I select a single "Gym" the "GymIDs" is automatically populated. I have then used the below VBA to allow me to select multiple "Gyms", I also want it to show me multiple "GymIDs".
Current vlookup =VLOOKUP(M7,Ignore!F1:G300,2,FALSE)
for some reason I could only upload one image so put them all together
excel table
VBA code for multiple selections
Private Sub Worksheet_Change(ByVal Target As Range)
'Code by Sumit Bansal from https://trumpexcel.com
' To Select Multiple Items from a Drop Down List in Excel
Dim Oldvalue As String
Dim Newvalue As String
On Error GoTo Exitsub
If Not Intersect(Target, Range("M7:M30")) Is Nothing Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
ElseIf Target.Value = "All" Then GoTo Exitsub
ElseIf Target.Value = "Select" Then GoTo Exitsub
ElseIf Target.Value = "" Then GoTo Exitsub
Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
ElseIf Oldvalue = "All" Then
Target.Value = Newvalue
ElseIf Oldvalue = "Select" 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'd suggest writing a function in the lookup column. As you've not provided the vlookup i'll leave that part to you. The main concept at play here is to detect whether the Gyms column is a single value or a comma separated list and treat it based upon that:
Public Function GymLookup(ByVal stringToProcess As String) As Variant
Application.Volatile
Dim var As Variant
Dim arrData As Variant
Dim strConcat As String
If InStr(1, stringToProcess, ",") > 0 Then
arrData = Split(stringToProcess, ",")
For Each var In arrData
'multiple handler
If strConcat = "" Then
strConcat = "enter your vlookup to resolve a result here"
Else
strConcat = strConcat & ", " & "enter your vlookup to resolve a result here"
End If
Next var
GymLookup = strConcat
Else
'Single cell lookup
GymLookup = "enter your vlookup to resolve a result here"
End If
End Function
There are certain columns in my database, that requires me to type in new data as well as make selections. So, I made a drop down list through data validation. I can select multiple selections according to the code, but if I keyed in any data into that cell, the original selection will show up twice.
Eg. Cell contains the choices: ABC, XYZ
I chose ABC, typed in WWW
The cell will then show ABC, ABC, WWW
Anyone can help prevent the duplication of the original choice?
Here is the code I currently have, I tried to remove the "oldVal" part to prevent duplication, it prevented me from choosing multiple choices.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 28 Or Target.Column = 29 Or Target.Column = 30 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
lUsed = InStr(1, oldVal, newVal)
If lUsed > 0 Then
If oldVal = newVal Then
Target.Value = ""
ElseIf Right(oldVal, Len(newVal)) = newVal Then
Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 1)
Else
Target.Value = Replace(oldVal, newVal & vbLf, "")
End If
Else
Target.Value = oldVal & vbLf & newVal
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
I have written down the lines that follow in order to allow the user to insert more that one entries in a data validated range. So if the dropdown list contains the elements: x1, x2, x3, .., xn, then, for any cell in the range, one can select and insert at first x1 value, then at the same cell select and insert x3 with the result being: x1, x3, and so it goes.
The problem is that when the user wishes to delete one of the value he gets an excel error saying the user has restricted the values for this cell. Therefore, he must delete the entire content of the cell and then select again the values he wants. Can you help improve this with regard to that?
Here is the code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'Column 7 is the one to which is the code is applied
ElseIf Target.Column = 7 Then
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If oldVal = "" Then
Else
If newVal = "" Then
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
Violating validation through VBA is possible, that's why your code works in the first place. Deleting an entry is a manual action where the cell content (a comma separated list) is being compared to your validation list.
You could do one of the following:
use your cell with validation for selection of items only, and write the comma separated selection to a different cell.
write an edit function for the cell - that way the result of the edit will be again written into the cell via VBA.
add the list (and all possible results from deletions into the validation list as well (very messy though)
try with below
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Range("G:G")
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
ElseIf Target.Column = 7 Then
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If oldVal = "" Then
Else
If newVal = "" Then
Else
Target.Value = oldVal & ", " & newVal
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
I'm trying to produce a code whereby the user can multiple items from a drop down menu (separated by a comma in the original cell) and then remove them by selecting the same item again. This pertains to only one column, I in the workbook and the other columns are regular columns where the user will be entering in text. I'm running into a problem in that the code that I have (see below) works on Column I but when the user tries to enter any information into other cells in other columns on the same worksheet, Run time error 1004 Application defined or object defined error pops up. When I press debug, it highlights If Target.Validation.Type = 3 Then. I copied this code from Contextures Inc and experience the same problem when I click on an outside cell in their test spreadsheet.
Any help would be much appreciated!
Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strVal As String
Dim i As Long
Dim lCount As Long
Dim Ar As Variant
If Target.Count > 1 Then GoTo exitHandler
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 9 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
On Error Resume Next
Ar = Split(oldVal, ", ")
strVal = ""
For i = LBound(Ar) To UBound(Ar)
Debug.Print strVal
Debug.Print CStr(Ar(i))
If newVal = CStr(Ar(i)) Then
'do not include this item
strVal = strVal
lCount = 1
Else
strVal = strVal & CStr(Ar(i)) & ", "
End If
Next i
If lCount > 0 Then
Target.Value = Left(strVal, Len(strVal) - 2)
Else
Target.Value = strVal & newVal
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
Add these lines immediately before If Target.Count > 1 Then GoTo exitHandler:
Set Target = Application.Intersect(Target, Me.Columns(9))
If Target Is Nothing Then Exit Sub
This will restrict the range Target only to cells in Column 9
Then you can remove this test:
If Target.Column = 9 Then
End If