My VBA is not running once a cell data is changed.
On my worksheet I have VBA running in Column F and G.
Column G has data validation that I want to trigger based on the numerical value input in column F.
Example:
Column F has a numerical value of 2.5 which results in Column G displaying "Good Standing".
If I change the Column F value to < 2, I want Column G cell to show blank
and vice versa if Column F value is originally < 2, and I increase it to > 2 Column G will display "Good Standing.
Private Sub Worksheet_Change(ByVal Target As Range)
StrtRow = 2
EndRow = Range("F" & Rows.Count).End(xlUp).Row
For i = StrtRow To EndRow
If Range("F" & i).Value >= 2 Then
Range("G" & i).Value = "Good Standing"
End If
Next
End Sub
You're missing an Else clause to clear the contents if < 2. Taking #SJR 's comment into account, try this (not tested)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngWatched As Range: Set rngWatched = Me.Range("F:F")
Dim cl As Range
If Not Intersect(rngWatched, Target) Is Nothing Then
Application.EnableEvents = False
For Each cl In Intersect(rngWatched, Target)
If cl.Value >= 2 Then
cl.Offset(0, 1).Value = "Good Standing"
Else
cl.Offset(0, 1).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
Related
I'm trying to vlookup multiple selection(comma seperated) in single cell and get the ouput in next sheet in single cell with single value (Either "Y" or "N") based on the input criteria (opt LCD vendor column in input table image) and functional usecase column (slection of multiple value ";" seperated) in input table image:
Output conditions:
I should get the output as "Y" only if both/all/multiple selected criteria (functional usecaeses) are "Y"
if one selection is "N" and the remaining are "Y", output should be "N"
Not sure it could be done in VBA / formula. could you please help on it.
As of now, Used this code for multi select functionality in functional usecase column & another 2 column
Private Sub Worksheet_Change(ByVal Target As Range)
'Code by Sumit Bansal from https://trumpexcel.com
' To allow multiple selections in a Drop Down List in Excel (without repetition)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
'MsgBox "called" + ActiveSheet.Name + "::" + Target.Address
If ActiveSheet.Name = "Input" Then
If (Target.Column = 19 Or Target.Column = 6 Or Target.Column = 13) Then
'If Target.Address = "O" 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
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & ", " & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
Sub test()
Set sh1 = Sheets("Sheet1")
Set rg = sh1.Range("B3", sh1.Range("B" & Rows.Count).End(xlUp))
Set sh2 = Sheets("Sheet2")
Set rgTbl = sh2.Range("A1", sh2.Range("F" & Rows.Count).End(xlUp))
For Each cell In rg
VL = "Y"
CL = rgTbl.Find(cell.Value, lookat:=xlWhole).Column
x = Split(cell.Offset(0, 1), ", ")
For i = LBound(x) To UBound(x)
VL = UCase(rgTbl.Find(x(i)).Offset(0, CL - 1))
If VL = "N" Then Exit For
Next
cell.Offset(0, 2).Value = VL
Next
End Sub
sh1 is the sheets where your "OPT LCD Vendor" reside.
So, change the sh1 according to your sheet name.
rg is the range of your "OPT LCD Vendor" header.
The code assumed that the data starts from cell B3 to the last rows which has value. rg values for example are : Outsystems, Any, Mendix, Unqork, etc.
sh2 is the sheet where your table has Y N.
So, change the sh2 according to your sheet name.
rgTbl is the range of the table in sh2.
The code assumed that the table starts from cell A1 to whatever last row in column F which has value. Change the range according to your need.
The process:
The code loop to each cell in rg,
get the value of the cell,
then find what column in rgTable this value exist, the CL variable.
The code split the value of the cell.offset(0,1) if the value has a comma separated.
For example, based on your image - the x variable will have two values : Life Origination and Accelerated Underwriting.
Then the code loop the value of x to get the VL is Y or N
Once it get the VL is N, it exit the loop, but it will continue if the value is not N. Finally the VL value (the result is Y or N) is put in column D of sh1 at the row of the looped cell, assuming that there is nothing in column D.
FYI, the value in column C of sh1 must always comma separated then one space. For example : Life Origination, Accelerated Underwriting ---> correct. Life Origination,Accelerated Underwriting ---> not correct.
This if I'm not mistaken to get what you mean.
I,ve tried to find a VBA solution for finding the previous cell (located on the same row) with different value than the selected cell has. So if the selected cell is for example [N6] (as in my picture) then my search range should be ("A6:N6") from which I need to find the last cell with a different cell value (which would be cell [L6] in my picture because it's the previous cell with a different value than cell [N6]. The search should start from the end (N6,M6,L6...) backwards until the first match is found (first different cell value). When the first match is found then select it. I have hundreds of columns, so my picture is just to show the principle. I execute my vba code with Private Sub Worksheet_SelectionChange(ByVal Target As Range) so when the user selects a cell with the mouse. I get the desired cell with {=ADDRESS(6;MATCH(2;1/(A6:O6<>"D")))} but I would need a VBA solution for my problem. My current VBA solution takes me to cell [I6] instead of [L6] and I can't figure out how to edit my code to find the correct cell ([L6] in my example picture).
Dim rngSel As String, rngStart As String
Dim rngActiveStart As Range
rngSel = ActiveCell.Address(0, 0)
rngStart = Cells(ActiveCell.Row, 1).Address(0, 0)
Set rngActiveStart = Range(rngStart & ":" & rngSel)
Dim c
For Each c In rngActiveStart.Cells
If c <> Target.Value And c.Offset(0, 1) = Target.Value Then
c.Select
MsgBox "Previous different cell: " & c.Address(0, 0)
Exit For
End If
Next
Using selection_Change
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Long, col As Long, x
Dim v As String
r = Target.Row
v = Target.Value
Application.EnableEvents = False
For x = Target.Column To 1 Step -1
With Me
If .Cells(r, x) <> v Then
.Cells(r, x).Select
Exit For
End If
End With
Next x
Application.EnableEvents = True
End Sub
You need a For i = max To min Step -1 loop to loop backwards/left:
Public Sub MoveLeftUntilChange()
Dim SelRange As Range 'remember the selected range 'N6
Set SelRange = Selection
Dim iCol As Long
For iCol = SelRange.Column To 1 Step -1 'move columns leftwards
With SelRange.Parent.Cells(SelRange.Row, iCol) 'this is the current row/column to test againts the remembered range N6
If .Value <> SelRange.Value Then 'if change found select and exit
.Select
Exit For
End If
End With
Next iCol
End Sub
hope someone can help
i have this code bellow working fine because i determined the range and exactly gave A1 numeric value as loop counter and starting point.
Private Sub Worksheet_Change(ByVal Target As Range)
If (Range("A1") <> "") And (IsNumeric(Range("A1"))) And (Range("A1") > 0) Then
Dim X As Integer
If Not Intersect(Target, Range("A1")) Is Nothing Then
For X = 1 To Range("A1").Value
Sheet4.Range("b" & X).Value = Range("A1").Value
Next X
MsgBox "done"
Else
End If
Else
MsgBox "no numeric"
End If
End Sub
now
i want to expand this code above so when user fill sheet1 A1 by 5 then paste values to 5 cells in sheet2 starting from first empty cell in sheet2 eg: b1:b5 or b10:b15 respectifly.
in next time i dont know in which cell in sheet1 column A will be filled may be A2' A3'A10'A80 or any A column cells so when it filled next time do the same thing loop for entered value times and paste or assign values to sheet2 b first empty cell and next to loop count cells.
the solution is
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("H:H")
If (Target.Value <> "") And (IsNumeric(Target.Value)) And (Target.Value > 0) And ((Target.HasFormula) = False) Then
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Dim X As Integer
Sheets("sheet2").Activate
For X = Sheets("sheet2").Range("G100").End(xlUp).Row To Sheets("sheet2").Range("G100").End(xlUp).Row + Target.Value - 1
Sheets("sheet2").Range("B" & X + 1).Value = Sheets("sheet1").Range("B" & Target.Row)
Sheets("sheet2").Range("C" & X + 1).Value = Sheets("sheet1").Range("C" & Target.Row)
Sheets("sheet2").Range("D" & X + 1).Value = Sheets("sheet1").Range("D" & Target.Row)
Sheets("sheet2").Range("E" & X + 1).Value = Sheets("sheet1").Range("E" & Target.Row)
Sheets("sheet2").Range("G" & X + 1).Value = "Enter serial"
Next X
'MsgBox Target.Address
MsgBox "done" & X
Else
End If
Else
MsgBox "Wrong Value! You Must Enter Number greater Than 0 "
End If
End Sub
but now how can i update the rows in sheet2 if a user change the value on sheet1 Range("H:H")
i need a way to insert new rows if the user entered greater value than the first he entered.
or
i need a way to delete extra rows if the user entered smaller value than the first he entered.
I would like to specify my excel to go on my cells. I mean when the first cell should be S5, and when this filled go to C6, then to C11, E11, G11, I11, K11, M11, O11, Q11, S11, then C12 E12........same method till s34 then goto H36.
I am try to use this:
If Not IsEmpty(Range("$C$11:$Q$11").Value) Then ActiveCell.Offset(0, 1).Select
Unfortunately in this case the active cell go one row down and one column right, and use not only in the specified range. I am not good in Excel macro.
Run this code and see what it does.
I'm not sure what exactly you are doing so this just shows the cell address as an illustration.
Sub x()
Dim cl As Range, r As Long
For r = 11 To 12
For Each cl In Range("C" & r & ", E" & r & ",G" & r)
MsgBox cl.Address
Next cl
Next r
End Sub
Take a look at the worksheet_change event. When you edit a cell you can then check which cell you are exiting from and force a move to the desired one.
By and large, the code below does what you describe. Please install it on the code sheet of the worksheet on which you want the action (NOT a standard code module). The correct location is critical for its functioning.
Private Sub Worksheet_Activate()
Cells(5, "S").Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Dim C As Long
Dim R As Long
If Target.Cells.CountLarge > 1 Then Exit Sub
Set Rng = Application.Union(Range("S5"), Range("C6"))
For C = 5 To 19 Step 2
Set Rng = Application.Union(Rng, Range(Cells(11, C), Cells(34, C)))
Next C
If Not Application.Intersect(Target, Rng) Is Nothing Then
Select Case Target.Row
Case 5
Rng.Areas(2).Select
Case 6
With Rng.Areas(1)
If Len(.Value) = 0 Then
GoBack .Row, .Column
Else
Rng.Areas(3).Cells(1).Select
End If
End With
Case Else
C = Rng.Areas.Count
With Rng.Areas(C)
If Target.Address = .Cells(.Cells.Count).Address Then
Cells(36, "H").Select
Else
With Target
R = .Row
C = .Column + 2
End With
If C > .Column Then
R = R + 1
C = Rng.Areas(3).Column
End If
Cells(R, C).Select
End If
End With
End Select
End If
End Sub
Private Sub GoBack(R As Long, _
C As Long)
Dim Cell As Range
Set Cell = Cells(R, C)
MsgBox "Cell " & Cell.Address(0, 0) & " must be filled first.", _
vbExclamation, "Missing data"
Cell.Select
End Sub
I have programmed it so that S5 is selected whenever the sheet is activated. After the user makes a change to it C6 will be selected. If C6 is changed the code checks if S5 was filled and directs the user to go back if it's still blank. This method could be expanded to encompass a complete check if all cells must be filled. As the code is now the selection moves to the next cell when a change is made and to H36 after S34 was filled.
I have the following spreadsheet. When ever there is an x in cell B I need to populate the d and e cells in the same row using an equation I have.
if there is no x in the b cell I need to manually enter values into cells d & e.
How do I make my code non-row specific?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim val As String
val = Range("B3").Value
If val = "x" Then
Range("E3").Value = Range("d2").Value * Range("G2").Value
Range("D3").Value = Range("D2").Value
End If
End Sub
I'm not sure if I understand correctly, but if you have a parameter: row = 3 you can use Range("E" & row) instead of Range("E3").
Put a loop around that where you vary 'row' for the rows you want to modify.
Hope that helps!
You've created a sub procedure around the Worksheet_SelectionChange event. In fact, you require Worksheet_Change and you need to,
disable event handling so you can write new values/formulas to the worksheet without running the Worksheet_Change on top of itself.
loop through each matching cell in Target to compensate for circumstances when Target can be more than a single cell,
add error control.
Rewrite:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
On Error GoTo safe_exit
Application.EnableEvents = False
Dim t As Range
For Each t In Intersect(Target, Range("B:B"))
If LCase(t.Value) = "x" Then
'I've made these formulas relative to each target
'you may want to make some absolute references
t.Offset(0, 3) = t.Offset(-1, 2) * t.Offset(-1, 5)
t.Offset(0, 2) = t.Offset(-1, 2)
Else
t.Offset(0, 2).resize(1, 2) = vbnullstring
End If
Next t
End If
safe_exit:
Application.EnableEvents = True
End Sub
Please try below code.
It loop through all non empty rows in column B and check if there is value: x
If so it populate your formulas.
Sub new_sub()
' get last_row of data
last_row = ActiveSheet.UsedRange.Rows.Count
' loop through all rows with data and check if in column B any cell contains value: x
For i = 1 To last_row
' if there is any cell with value: x
' then add below formulas
If Cells(i, 2).Value = "x" Then
' for column E: take value from row above for col D and G and multiple
Range("E" & i).Value = Range("d" & i - 1).Value * Range("G" & i - 1).Value
' for column D: take value from row above
Range("D" & i).Value = Range("D" & i - 1).Value
End If
Next i
End Sub