I wrote the code below to clear the cell in column D only if the value of the cell in in the corresponding row of column B changes to a value that is part of a specific list/range (B118:B124). If I change the cell in B to any value that is not part of that list, the cell in the corresponding row in D will not clear (that is what I want).
The code below works fine, except, if for example I want to delete 5 (adjacent) cells in column B at the same time, I get runtime error 13. Same is the case if I enter a new value in the first of the deleted/blank cells and then try to auto fill it down to the rest of deleted/blank cells. Basically, the code below seems to not work if I want to change multiple cells in B at the same time (autofill,...). If I only delete/change one cell (in B) at a time, it works just fine. Any help would be greatly appreciated. Thanks.
Private Sub Worksheet_Change (ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Application.WorksheetFunction.CountIf(Range("B118:B124"), Target) Then
Range("D" & Target.Row).ClearContents
End If
End If
End Sub
I think the issue is that COUNTIF is expecting a singular value, not a range containing values. Try this instead:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
For Each cell In Range(Target.Address)
If Application.WorksheetFunction.CountIf(Range("B118:B124"), cell) Then
Range("D" & cell.Row).ClearContents
End If
Next cell
End If
End Sub
EDIT: Updated answer with everyone's contributions:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
For Each cell In Target
If Not Intersect(cell, Range("B:B")) Is Nothing Then
If Application.WorksheetFunction.CountIf(Range("B118:B124"), cell) Then
Application.EnableEvents = False
Range("D" & cell.Row).ClearContents
Application.EnableEvents = True
End If
End If
Next cell
End If
End Sub
When selecting a range, you must process each individually in this case. Loop the range in target and done.
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Target
If Not Intersect(cell, Range("B:B")) Is Nothing Then
If Application.WorksheetFunction.CountIf(Range("B118:B124"), cell) Then
Range("D" & cell.Row).ClearContents
End If
End If
Next
End Sub
Related
Based on a language table, column A = Language, B = number, C = coloredcell
I would like to know what is the VBA so whenever I type a number on Column B (using Workbook_SheetChange), C is colored with the Colorindex equal to the number typed.
On the other hand, and I am sure is part of the solution to the previous question, on VBA how do I write cell.Interior.ColorIndex = (a specific cell value, If B2=4 -> for the row, whole or until last column has data, cell.Interior.ColorIndex = 4) and color the whole row.
Thank you
The sheetchange function has target as an argument, that's the cell that you changed. You can use it to change the relevant cell:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
Target.Offset(0,1).Interior.ColorIndex = Target.Value
'and for the whole row
Target.EntireRow.Interior.Color = Target.Offset(0,1).Interior.Color
Endif
End Sub
The code of Nick Dewitt is OK, but it color only the column C.
If you want to color the entire row, starting from C depending of how much columns are in the row :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastcol As Integer, i As Integer
If Target.Column = 2 Then
lastcol = Cells(Target.Row, Columns.Count).End(xlToLeft).Column
For i = 3 To lastcol
Target.Offset(0, i - 2).Interior.ColorIndex = Target.Value
Next i
End If
End Sub
Right click on the sheet's name on which you want this functionality, and click on 'View Code'.
Now you need to write a VBA function that fires on any change to the worksheet. This is an inbuilt function called Worksheet_Change(Range). The range object (it's argument) is the range that had changed when this function fired.
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
Inside the function you need to check whether the changed cell was in column B. This is done by the Column property of the Target range.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
' The changed cell was in column B
End If
End Sub
Now you need to get the cell's value and put it as the row's ColorIndex.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
ColorValue = Target.Value
Target.EntireRow.Interior.ColorIndex = ColorValue
End If
End Sub
Edit: To color the cells only till the last value in the row, you need to count the number of filled cells in the row. The following code does that (see the comments to understand it)
Private Sub Worksheet_Change(ByVal Target As Range)
' Check if the edited cell is in column B
If Target.Column = 2 Then
' Get the value of the edited cell
ColorValue = Target.Value
' Get the row number of the edited cell
RowNumber = Target.Row
' Get the number of filled cells in this row
CellsCount = Application.WorksheetFunction.CountA(Range(RowNumber & ":" & RowNumber))
' Apply the color formatting till the last column in this row
Range(Cells(RowNumber, 1), Cells(RowNumber, CellsCount)).Interior.ColorIndex = ColorValue
End If
End Sub
I need to build a linked search function in VBA that also auto-updates after you enter data into the given search fields. I have been able to do this successfully with the following sections of code:
Autofilter search - in a standard module
Code:
Sub FilterTo1Criteria()
With Sheet3
If Range("A3") <> vbNullString Then
.AutoFilterMode = False
.Range("A6:J1015").AutoFilter
.Range("A6:J1015").AutoFilter Field:=1, Criteria1:=Range("A3")
Else
Selection.AutoFilter
End If
End With
End Sub
Sheet change/auto-update - This is in a worksheet module
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$3" Then
Application.EnableEvents = False
FilterTo1Criteria
Application.EnableEvents = True
End If
End Sub
However, within the sheet change page, I need cells A3:J3 to be the criteria, but I also need the auto search function to work if only A3 and D3 are filled in, or if just A3 is filled in (D3 is blank), or if just D3 is filled in (A3 is blank), but I'm having issues trying to compound the code to get this effect. How much more complicated will I have to make it? Are there some examples that someone is aware of that I can look at to glean some information from? It's hard to find any...
A slicer with a pivot table is a potential way to go, but I think some people downstream are using Excel 2003 and I don't think the slicer works back that far.
Thanks in advance!
For the function to work if either A3 or D3 are not empty, then you can concatenate the two cells and compare that to vbNullString.
For the multiple filters, you can use a loop to set them all.
eg:
Sub FilterTo1Criteria()
Dim i As Long
With Sheet3
If Range("A3") & Range("D3") <> vbNullString Then
.AutoFilterMode = False
.Range("A6:J1015").AutoFilter
For i = 1 To 10
.Range("A6:J1015").AutoFilter Field:=i, Criteria1:=Cells(3, i)
Next i
Else
Selection.AutoFilter
End If
End With
End Sub
Edit:
It looks like you wanted to set the filters as the criteria cells were filled, rather than all at once. Try this instead:
Sub FilterTo1Criteria()
Dim i As Long
With Sheet3
.AutoFilterMode = False
.Range("A6:J1015").AutoFilter
For i = 1 To 10
If .Cells(3, i) <> vbNullString Then
.Range("A6:J1015").AutoFilter Field:=i, Criteria1:=.Cells(3, i)
End If
Next i
End With
End Sub
and for the new worksheet change sub:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("$A$3:$J$3")) Is Nothing Then
Application.EnableEvents = False
FilterTo1Criteria
Application.EnableEvents = True
End If
End Sub
This will add or remove filters as you add or remove criteria (row 3).
I am very inexperienced with VBA and coding in general.
I am working on a spreadsheet where column A is job numbers.
Column B is Dates.
Columns C, D and E you have to put a mark in E.G Text that has no pattern.
Now I have worked out code to put the date in column B if any mark is put in C, D or E. However if you then delete C, D or E the cell in column B is still populated with the date.
Just to be clear C, D or E could have text in them or on 2 or 1.
Now I know you could just delete the cell but where is the fun in that .
Here is the code I have so far please feel free to suggest way to make it smaller or clear it up, but mainly away to sort out my issue thanks in advance.
Private Sub Worksheet_Change(ByVal Target As Range)
Call Macro1(Target)
Call Macro2(Target)
Call Macro3(Target)
End Sub
Sub Macro1(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("c2:c100")) Is Nothing Then
With Target(1, 0)
.Value = Date
.EntireColumn.AutoFit
End With
End If
End Sub
Sub Macro2(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("d2:d100")) Is Nothing Then
With Target(1, -1)
.Value = Date
.EntireColumn.AutoFit
End With
End If
End Sub
Sub Macro3(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("e2:e100")) Is Nothing Then
With Target(1, -2)
.Value = Date
.EntireColumn.AutoFit
End With
End If
End Sub
This code either inserts a date in Column B when columns C, D or E in that row are changed and at least one of them is non-blank. Conversely, the cell in Column B is cleared if all three are blank:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Me.Range("c2:E100")) Is Nothing Then
With Intersect(Target.EntireRow, Me.Range("B2:B100"))
If WorksheetFunction.CountBlank(Intersect(Target.EntireRow, Me.Range("C2:E100"))) <> 3 Then
.Value = Date
.EntireColumn.AutoFit
Else
.Value = ""
End If
End With
End If
End Sub
you just add a check
If Target.Value = "" Then dateCell.ClearContents
where dateCell is the cell where the date resides in the current row
but you must also:
disable/enable events
to prevent Worksheet_Change() fire again when changing "date" cell (this occurs also when deleting a cell value
use one sub to handle all three columns
just check if target intersects columns C to E. like
If Not Intersect(.Cells, Range("C:E")) Is Nothing Then
see code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Call Macro1(Target)
End Sub
Sub Macro1(ByVal Target As Range)
Dim dateCell As Range
With Target
If .Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False '<--| disable events to prevent this one fire when changing "date" cell
If Not Intersect(.Cells, Range("C:E")) Is Nothing Then
Set dateCell = Cells(.row, "B") '<--| set the cell where "date" resides
If Application.WorksheetFunction.CountA(.Parent.Cells(.row, "C").Resize(, 3)) = 0 Then '<--| if there are no values in current row columns C to E ...
dateCell.ClearContents '<--|... clear the date
Else
dateCell.Value = Date '<--|... otherwise put the date in column B and ...
dateCell.EntireColumn.AutoFit '<--| ... autofit column B
End If
End If
Application.EnableEvents = True '<--| enable events back on
End With
End Sub
Basically, I have a rather large (and growing) sheet of position details and I'm looking to build in a sub routine that, once a position number is entered into the relevant cell, will auto-populate the corresponding cells in the row. VLOOKUP would do the trick nicely except, when a position has multiple lines, it returns the earliest set of details--I need it to return the latest.
I can produce the answer I need using a LOOKUP function , but I can't seem to translate the function across to VBA.
Example lookup function:
LOOKUP(D17,1/($D$2:$D$10=D17),E2:E10)
This is what I have so far
Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = 4 Then
actionrow = Target.Row
resulte = Application.WorksheetFunction.Lookup(2, 1 / Range("D2:D10") = Target.Value, Range("E2:E10"))
If Target.Value <> "" Then
Range("E" & actionrow).formula = resulte
End If
End If
End Sub
I think that looking at column D for a matching value with the Range.Find method would do. Start at the Target cell and use the SearchDirection:=xlPrevious option. Something will always be found. If the row it is found is not the same row as Target then use the value in column E to populate the cell right of Target.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Columns(4), Target) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = True
Dim trgt As Range, lastrw As Long
For Each trgt In Intersect(Columns(4), Target)
lastrw = Columns(4).Find(what:=trgt.Value, after:=trgt, _
lookat:=xlWhole, SearchDirection:=xlPrevious).Row
Debug.Print lastrw
If lastrw <> trgt.Row Then
trgt.Offset(0, 1) = Cells(lastrw, trgt.Column + 1).Value
End If
Next trgt
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
This should survive pasting multiple values into column D.
You can use .Find function with parameter SearchDirection:=xlPrevious
For case where you are searching word "AC" in a row 4:
Set FindCell = sh_wb_SF.Range("4:4").Find(What:="AC", LookIn:=xlValues, SearchDirection:=xlPrevious)
If FindCell Is Nothing Then
MsgBox ("Ooooooopppps")
End If
im a noob.
My macro adds a date when a cell value changes to "Closed".
Specifically, when a cell value in column M changes to "Closed", it adds the date 2 cells to the left, in column K.
Works perfectly, until i edit more than one cell in either column. If i do that, i get a 13 type mismatch error.
This sucks as it means an error comes up each time i autofill.
Click for image of problem...
thanks in advance.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 13 And Target = "Closed" Then
Target.Offset(0, -2) = Format(Now(), "yyyy-mm-dd")
End If
End Sub
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
For Each cell In Target
If cell.Column = 13 And cell = "Closed" Then
Target.Offset(0, -2) = Format(Now(), "yyyy-mm-dd")
End If
Next cell
End Sub