I want the value from column M to be set depending on the value from column L and comparing it to the value from column K. Any help would be great
I tried taking an Offset approach but nothing happens
If Intersect(Target, Columns("L")) Is Nothing Then Exit Sub
For Each cl1 In Intersect(Target, Columns("L"))
If cl1 <= cl1.Offset(0, -1).Value Then
cl1.Offset(0, 1).Value = cl1.Offset(0, -2).Value * cl1 * Sheet1.Range("M7").Value
Else
cl.Offset(0, 1).Value = "Text"
End If
Next
This will work:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 12 Then
For Each cl1 In Intersect(Target, Columns("L"))
If cl1.Value <= cl1.Offset(0, -1).Value Then
cl1.Offset(0, 1).Value = cl1.Offset(0, -2).Value * cl1.Value * Range("M7").Value
Else
cl1.Offset(0, 1).Value = "Text"
End If
Next
End If
End Sub
Make sure your code Pasted in the Sheet you are working on.
Related
I am trying to create a For and Do while loop in VBA. I want that when the value 'X' is entered in column A and if column W is equal to "T", all the rows below (column A) should be checked "X" until the next value "T" in column W.
My script does not work, only the row below is filled with "X" and the file closes (bug!)
Here is the complete code
Sub Chaine()
For Each Cell In Range("A2:A3558")
If UCase(Cell.Value) = "X" And Cells(Target.Row, 23) = "T" Then
Do While Cell.Offset(0, 23) <> "T"
Cell.Offset(1, 0).Value = "X"
Loop
End If
Next Cell
End Sub
Try this:
Sub Chaine()
Dim c As Range, vW, flag As Boolean
For Each c In ActiveSheet.Range("A2:A3558").Cells
vW = UCase(c.EntireRow.Columns("W").value)
If UCase(c.value) = "X" And vW = "T" Then
flag = True 'insert "X" beginning on next row...
Else
If vW = "T" Then flag = False 'stop adding "X"
If flag Then c.value = "X"
End If
Next c
End Sub
Your Do While loop has to be problem as it doesn't change and will continue to check the same thing. It's unclear what you want to happen, but consider something like this as it moves to the right until you've exceeded the usedrange.
Sub Chaine()
Dim cell As Range
For Each cell In Range("A2:A3558").Cells
If UCase(cell.Value) = "X" And Cells(Target.Row, 23) = "T" Then
Do While cell.Offset(0, 23) <> "T"
Set cell = cell.Offset(0, 1)
'not sure what this is supposed to do...?
'cell.Offset(1, 0).Value = "X"
If cell.Column > cell.Worksheet.UsedRange.Cells(1, cell.Worksheet.UsedRange.Columns.Count).Column Then
MsgBox "This has gone too far left..."
Stop
End If
Loop
End If
Next cell
End Sub
I just went off your description in the question. Your code is not doing what you want and it's not really how you would do this in my opinion. I figured I would put an answer that does what you ask but, keep it simple.
I'm guessing Target in the code refers to an event.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo SomethingBadHappened
'Checks if you are in the A column from the target cell that
'was changed and checks if only X was typed.
If (Target.Column = 1 And UCase(Target) = "X") Then
Dim colToCheck_Index As Integer
colToCheck_Index = 23 'W Column
Dim colToCheck_Value As String
Dim curRow_Index As Integer
curRow_Index = Target.Cells.Row
'Checks if the column we are checking has only a T as the value.
If (UCase(ActiveSheet.Cells(curRow_Index, colToCheck_Index).Value) = "T") Then
Application.EnableEvents = False
Do
'Set the proper cell to X
Range("A" & curRow_Index).Value = "X"
curRow_Index = curRow_Index + 1
'Set the checking value to the next row and check it in the
'while loop if it doesn't equal only T
colToCheck_Value = ActiveSheet.Cells(curRow_Index, colToCheck_Index)
'Set the last row to X on the A column.
Loop While UCase(colToCheck_Value) <> "T"
Range("A" & curRow_Index).Value = "X"
Application.EnableEvents = True
End If
Exit Sub
SomethingBadHappened:
Application.EnableEvents = True
End If
End Sub
I have 5 columns ((a)uptick, (b)downtick, (c)original, (d)current), and (e) Stored Value. All columns need to be a range of rows. When d2 changes I want to compare it to e2 and if d2>e2 then bump the counter in a2 by 1 (uptick), if d2<e2 then bump the counter in b2 (downtick). I have it working with many if and elseif statements but would rather use less code using variables for the range. To detect the changing cell I use "If Not Intersect (Target, Range("d2:d10")) Is Nothing Then...."
I cannot seem to figure out how to replace specific cell references with ranges. Any help would be most appreciated!
Sample Code below not using ranges yet.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D2:D10")) Is Nothing Then
If Target.Value > Range("E2") Then
Range("A2") = Range("A2") + 1
Pause 2#
Range("E2") = Target.Value
ElseIf Target.Value < Range("E2").Value Then
Range("B2") = Range("B2") + 1
Pause 2#
Range("E2") = Target.Value
End If
End If
End Sub
I assume you want to change the cell value in the same row that the value was entered in column D, i.e. if D4 has been changed, then adjust A4 or B4. To do that, you need the row number of the changed cell. You can extract that with target.row. Throw that into a variable and use the variable instead of the row number in the Range() property.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D2:D10")) Is Nothing Then
dim myRow as long
myRow = target.row
If Target.Value > Range("E" & myRow) Then
Range("A" & myRow) = Range("A" & myRow) + 1
Pause 2#
Range("E" & myRow) = Target.Value
ElseIf Target.Value < Range("E" & myRow).Value Then
Range("B" & myRow) = Range("B" & myRow) + 1
Pause 2#
Range("E" & myRow) = Target.Value
End If
End If
End Sub
You could use .Offset to get the same result. The following code assumes you're only interested in the range D2:D10 and aren't concerned if the value in column D equals the value in column E.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("D2:D10"), Target) Is Nothing Then
If Target.Rows.Count > 1 Then Exit Sub
If Target > Target.Offset(, 1) Then
Target.Offset(, -3) = Target.Offset(, -3) + 1
Else
If Target < Target.Offset(, 1) Then
Target.Offset(, -2) = Target.Offset(, -2) + 1
End If
End If
End If
End Sub
I have a problem with my VBA code. Generally, each line of code works as it should, but if I try to delete values (even empty cells) of at least two lines in the E column (select and delete), I get
Run-time error '13': Type mismatch
I read that it was because of not declaring a variable, but I don't know what is missing.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCellsKolumnE As Range
Set KeyCellsKolumnE = Range("E2:E100")
If Not Application.Intersect(KeyCellsKolumnE, Range(Target.Address)) _
Is Nothing Then
If Range(Target.Address).Value = "TEXT1" _
Or Range(Target.Address).Value = "TEXT2" Then
Range(Target.Address).Offset(, 3).Value = "TEXT3"
ElseIf Range(Target.Address).Value = "TEXT4" _
Or Range(Target.Address).Value = "TEXT5" _
Or Range(Target.Address).Value = "TEXT6" Then
Range(Target.Address).Offset(, 3).Value = "TEXT7"
ElseIf Range(Target.Address).Value = "TEXT7" Then
Range(Target.Address).Offset(, 3).Value = "TEXT7"
Range(Target.Address).Offset(, 10).Value = "TEXT8"
ElseIf Range(Target.Address).Value = "" Then
Range(Target.Address).Offset(, 3).Value = ""
Else
Range(Target.Address).Offset(, 3).Value = ""
End If
End If
End Sub
As BigBen pointed out, the main issue should be the multicell Target, which calls for a loop
Also, you might want to ensure the multicell Target is compeletly inside column E
I also turned the If ElseIf EndIf syntax into a Select Case one
Finally, I throw in the good coding pratice to avoid multiple recursive callings in such an event handler
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCellsKolumnE As Range
Set KeyCellsKolumnE = Range("E2:E100")
If Not Application.Intersect(KeyCellsKolumnE, Target) Is Nothing And Target.Columns.CountLarge = 1 Then ' make sure Target is completely inside column E
On Error GoTo SafeExit
Application.EnableEvents = False ' disable events to prevent recursive calling
Dim cel As Range
For Each cel In Target ' loop through each Target cell
With cel ' reference current cell
Select Case .Value
Case "TEXT1", "TEXT2"
cel.Offset(, 3).Value = "TEXT3"
Case "TEXT4", "TEXT5", "TEXT6"
.Offset(, 3).Value = "TEXT7"
Case "TEXT7"
.Offset(, 3).Value = "TEXT7"
.Offset(, 10).Value = "TEXT8"
Case Else
.Offset(, 3).ClearContents
End Select
End With
Next
End If
SafeExit:
Application.EnableEvents = True ' restore events back
End Sub
I want to filldown the formula below to row 4 to row 40:
If Target.Address = Range("E13").Address Then
ActiveSheet.Range("H13").Value = ActiveSheet.Range("E13").Value * ActiveSheet.Range("G13")
ElseIf Target.Address = Range("H13").Address Then
ActiveSheet.Range("E13").Value = ActiveSheet.Range("H13").Value / ActiveSheet.Range("G13")
End If
How can I do this?
I'll assume from your use of Target that the code is from a Worksheet_Change event procedure.
Private Sub Worksheet_Change(ByVal Target As Range)
if not intersect(target, Range("E4:E40, H4:H40")) is nothing then
on error goto safe_exit
application.enableevents = false
dim t as range
for each t in intersect(target, Range("E4:E40, H4:H40"))
select case t.column
case 5
cells(t.row, "H") = cells(t.row, "E") * cells(t.row, "G")
case 8
'you might want to make sure cells(t.row, "G") isn't zero
cells(t.row, "E") = cells(t.row, "H") / cells(t.row, "G")
end select
next t
End If
safe_exit:
application.enableevents = true
End Sub
I have an Excel 2010 form. I am trying to change the row color based on several variables.
I do understand that this can be accomplished with conditional formatting and have got that to work, but cutting and pasting, as my users will likely do, kills the formatting. I was hoping that VBA would fix that. Possibly there is some other solution I am unaware of.
This is what I want to happen (the so called logic)
on Sheet3
Columns (a – w)
rows (2 – 10485)
upon a change in any field, $x2, or a past due date in $T2
if(AND($X2="Open",$T2<>"",$T2<=TODAY()) then all row red ($a2-$x2)
if(AND($X2="Open",$T2="",$T2>TODAY()) then all row white ($a2-$x2)
=$X2="Completed" then all row grey ($a2-$x2)
=$X2="Rescinded" then $X2 = orange and $A2 thru $W2 = grey
The x field will use a drop down and be either ( blank, open, completed, or rescinded )
This is the code I have tried to hobble together and failed with.....
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:X1048567")) Is Nothing Then Exit Sub
Select Case Cells(Target.Row, "X").Value
Case "Open"
If Cells(Target.Row, "T").Value <> "" And T2 <= TODAY() Then 'Range(Cells(Target.Row, "A"), Cells(Target.Row, "F")).Interior.ColorIndex = 3
Else
Range(Cells(Target.Row, "A"), Cells(Target.Row, "F")).Interior.ColorIndex = x1None
End Select
Case "Completed"
Range(Cells(Target.Row, "A"), Cells(Target.Row, "F")).Interior.ColorIndex = 15
Case "Rescinded"
Range(Cells(Target.Row, "A"), Cells(Target.Row, "F")).Interior.ColorIndex = 15
Range(Cells(Target.Row, "A"), Cells(Target.Row, "F")).Interior.ColorIndex = 46
Case ""
Range(Cells(Target.Row, "A"), Cells(Target.Row, "F")).Interior.ColorIndex = xlNone
End Select
End Sub
There were a few discrepancies between what you described and what your code sample indicated so I went with the former.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:X")) Is Nothing Then
On Error GoTo safe_exit
Application.EnableEvents = False
Dim rw As Long, rng As Range
For Each rng In Intersect(Target, Range("A:X"))
rw = rng.Row
If rw > 1 Then
Select Case LCase(Cells(rw, "X").Value2)
Case "open"
If Cells(rw, "T").Value <> "" And Cells(rw, "T").Value <= Date Then
Cells(rw, "A").Resize(1, 24).Interior.ColorIndex = 3
Else
Cells(rw, "A").Resize(1, 24).Interior.Pattern = xlNone
End If
Case "completed"
Cells(rw, "A").Resize(1, 24).Interior.ColorIndex = 15
Case "rescinded"
Cells(rw, "A").Resize(1, 23).Interior.ColorIndex = 15
Cells(rw, "X").Interior.ColorIndex = 46
Case Else
Cells(rw, "A").Resize(1, 24).Interior.Pattern = xlNone 'use pattern to turn off interior fill
End Select
End If
Next rng
End If
safe_exit:
Application.EnableEvents = True
End Sub
That should also handle multiple entries like those received from pasting a number of values into the sheet. By 'white' I assumed that you meant to remove any fill color, not actually provide a white fill color.