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
Related
I have a macro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v
If Target.Cells.Count <> 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
v = Target.Value
If VarType(v) <> vbDate Then
Application.EnableEvents = False
If v Like "???##" Or v Like "???-##" Then Target.Value = Left(v, Len(v) - 2) & "20" & Right(v, 2)
If VarType(Target.Value) <> vbDate Then Target.Value = Empty
Target.NumberFormat = "m/d/yyyy"
Application.EnableEvents = True
End If
End Sub
When copying (ex: may20, may-20) from another column to column A in Excel itself with this macro, it allows to paste only once - the next cell is no longer pasted, apparently, the clipboard is cleared after the first paste. I have to copy again from another column. How it can be corrected?
See below - if you need to paste the same value again.
The core problem is that the change event always clears the clipboard - there's no (easy) way I'm aware of to prevent that.
Private Sub Worksheet_Change(ByVal Target As Range)
Const MNTH_NM As String = "[A-Z][A-Z][A-Z]" 'a bit better than "???"
Dim v
If Target.Cells.Count <> 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
v = Target.Value
If Len(v) > 0 Then
Application.EnableEvents = False
If UCase(v) Like MNTH_NM & "##" Or UCase(v) Like MNTH_NM & "-##" Then
v = Left(v, 3) & "-20" & Right(v, 2)
Target.NumberFormat = "m/d/yyyy"
Target.Value = v
Target.Copy
Else
Target.ClearContents 'if doesn't match the pattern, clear it
End If
Application.EnableEvents = True
End If 'non-zero length
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 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.
Having trouble with time formatting.
I have set the cell to custom format 00:00.
Currently in column A a date is inputted, this can be as 0300 which converts to 03:00 which is perfect or you can just enter 03:00.
I now have a problem if a user enters 03;00 as i need this to display 03:00
how can i ensure that all times are in the hh:mm format and not in hh;mm etc.
This needs to auto change on input for anything in column A, except what is the header (A1:A5) although this should not be affected.
Thanks
On your sheets change event you would place the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge = 1 And Target.Column = 1 And Target.Row > 5 Then
Target.Value2 = Replace(Target.Value2, ";", ":")
End If
End Sub
Explaining the code... it first checks to make sure that the change isn't on multiple cells (ie paste) and that the change is on column A below Row 5. If it does pass the conditional it simply replaces ; for :.
This does what i require.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim xStr As String
Dim xVal As String
Set rng1 = Range("A:A")
Set rng2 = Range("C:C")
Set rng3 = Range("I:I")
On Error GoTo EndMacro
If Application.Intersect(Target, Union(rng1, rng2, rng3)) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Row < 5 Then Exit Sub
Application.EnableEvents = False
With Target
If Not .HasFormula Then
Target.Value = Replace(Target.Value, ";", ":")
Target.Value = Left(Target.Value, 5)
xVal = .Value
Select Case Len(xVal)
Case 1 ' e.g., 1 = 00:01 AM
xStr = "00:0" & xVal
Case 2 ' e.g., 12 = 00:12 AM
xStr = "00:" & xVal
Case 3 ' e.g., 735 = 07:35 AM
xStr = "0" & Left(xVal, 1) & ":" & Right(xVal, 2)
Case 4 ' e.g., 1234 = 12:34
xStr = Left(xVal, 2) & ":" & Right(xVal, 2)
Case 5 ' e.g., 12:45 = 12:45
xStr = Left(xVal, 2) & Mid(xVal, 2, 1) & Right(xVal, 2)
Case Else
Err.Raise 0
End Select
.Value = Format(TimeValue(xStr), "hh:mm")
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
Application.EnableEvents = True
End Sub
Thanks
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.