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
Related
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
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
In the spreadsheet, I want to make it automatically select column P whenever I type the letters FR and press enter into any cell in column F.
What code will do this?
Add the following event routine to the worksheet's code module
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 And Target.Text = "FR" Then Target.Offset(, 10).Select
End Sub
If you want to select the whole column P not only the cell on the same row,
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 And Target.Text = "FR" Then Columns("P").Select
End Sub
Maybe due to my poor English some of you may misunderstood what I wanted to do. Anyways, here is the code that I wanted. After many trial and errors I made it but I doubt its the best way but it works =). If anyone know how to make the code better please tell me =).
I previous post is also below this new code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim row As Integer
For row = 1 To 1000
If Cells(row, "A").Value = "Yes" Then
Range("B" & row).Interior.ColorIndex = 4
End If
If Cells(row, "A").Value = "yes" Then
Range("B" & row).Interior.ColorIndex = 4
End If
Next row
End Sub
Previous post
I have written a VBA code in excel where I want to change a cell color everytime I write "yes". In this case I write "yes" in column E and column A should change color. I have used a for loop but it does not run as I want. I have a feeling I am thinking a bit wrong...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellNr As Long
For cellNr = 1 To 5
If Range("E" & cellNr).Value = "yes" Then
Range("A" & cellNr).Interior.ColorIndex = 5
Else
ActiveCell(0, -2).Interior.ColorIndex = 4
End If
Next cellNr
End Sub
Use conditional formatting with a formula. Starting in row 1 the formula required is
=$E1="yes"
If I understand what you are trying to do with the following line:
ActiveCell(0, -2).Interior.ColorIndex = 4
Replace it with:
ActiveCell.Offset(0, -2).Interior.ColorIndex = 4
As far as I know, the line I told you to remove will always throw an error. It doesn't make any sense syntactically. You should use the Offset function to get positions relative to the Active Cell. But also, this offset function will throw an error if your active cell is in column A or B because there are less than 2 columns to the left of the active cell.
Consider:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rOfInterest As Range
Set rOfInterest = Range("E1:E5")
If Intersect(Target, rOfInterest) Is Nothing Then Exit Sub
v = Target.Value
If v = "yes" Then
Target.Offset(0, -4).Interior.ColorIndex = 5
Else
Target.Offset(0, -4).Interior.ColorIndex = 4
End If
End Sub
and make sure the macro is in the worksheet code area.
I have a train arrival/departure timetable, each branch line is on a separate row. I need to make the spreadsheet automatically detect change in cell and change all cells to the right from it for the same amount of time. Cells have format of time. How do I do that?
What I've tried so far:
I found this piece of code in some other question on SE:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("H5")) Is Nothing Then Macro
End Sub
But I wasn't able to understand where to put it and how to make it work automatically, apart from working for a specific range, which might be different from what was in the question where I found it.
UPD: The logic I'm looking for in VBA:
Wait until a cell is selected, if it has Time format, copy its value to Tmp.
Save the difference between old and new values to Tmp.
If a cell to the right contains something and its format is Time, add Tmp to it.
Continue until cell is empty.
if you know how much difference is between times, then you can calculate the new time based on that difference.
e.g. A1 is 10:07, A2 is 10:14. Instead of having to type in each time individually, you could have A2 as =A1+TIME(0,7,0). Then when you changed A1 to 10:15, A2 would automatically change to 10:22
OK this may get you started in the right direction:
You first want to store all the original cell values. So, the following VBA code stores the values in column A for the first 200 rows into an array. You need to run this code first, perhaps when the workbook is opened:
Dim contents(200) As Variant
Public Sub StoreOriginalValues()
' save all existing values
For r = 1 To 200 ' change for number of rows you have
contents(r) = Worksheets(1).Cells(r, 1).Value
Next
End Sub
Once the original cell values are stored, you can place code in the Worksheet_Change event so that whenever the user changes a cell in column A you can compare the original and new value and figure out the difference. Then you can apply this difference to the rest of the columns in that row:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then ' only check for changes in column A
originalvalue = contents(Target.Row)
newvalue = Target.Value
contents(Target.Row) = Target.Value
difference = newvalue - originalvalue
Set chgcell = Cells(Target.Row, Target.Column + 1)
Do While Not IsEmpty(chgcell)
chgcell.Value = chgcell.Value + difference
Set chgcell = chgcell.Offset(0, 1) ' move one column to right
Loop
End If
End Sub
Now this code is by no means perfect. It does not check that they entered a valid time, for instance. It also does not check to see if the values entered in the rest of the columns in the row are times or text or whatnot. But like I said I hope it will point you in the right direction.
My solution:
Dim oldVal
Dim diff
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
oldVal = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
ActiveCell.Offset(-1, 0).Select
Application.EnableEvents = True
diff = Target.Value - oldVal
If Not diff = 0 Then
While Not ActiveCell.Offset(0, 1) = "#"
Application.EnableEvents = False
ActiveCell.Offset(0, 1).Select
Application.EnableEvents = True
If Not ActiveCell Is Nothing _
And Not ActiveCell = "" _
And TypeName(ActiveCell) = TypeName(ActiveCell.Offset(0, -1)) Then
Application.EnableEvents = False
ActiveCell.Value = ActiveCell.Value + diff
Application.EnableEvents = True
End If
Wend
End If
End Sub
This has been my first experience with VB in a very long time, so the code is terrible, but it works.