I have a spread sheet which is used for basic scheduling of tasks.
Dates for the calendar run along Row 1 from O-NO and everything below is job related including due dates.
I am trying to automatically add a note to the calendar section of the sheet when a date is added to column E. The word “Due Date” is update to the corresponding text row/date column.
Colum E = due dates, Columns O to NO (rows are infinite) are days Jan – Dec. I have created the cell formula =IF((AND($E452=$1:$1)),"Due Date","") which is cell specific.
I need to keep the cells clear of formulas because they are used for adding other details so a Macro is the way to go.
I thought I could convert the formula to a macro and then manipulate the code to do what I need across all of the calendar cells. Below is the result.
Sub DueDate()
'
' DueDate Macro
'
'
Range("IM451").Select
ActiveCell.FormulaR1C1 = "=IF((AND(RC5=R1)),""Due Date"","""")"
Range("IM452").Select
End Sub
Firstly I tried a number of ways just to get this macro to run automatically without having to manually run it. For some reason I couldn’t get it to work.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
MACRO CODE HERE
End If
End Sub
Plus a couple of other versions
Second step was to get it to work across all of the calender cells, another fail.
Would really appreciate some assistance on this.
Thank you
CRB
If I understand what you're trying to do correctly, then try this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False
If Target.Cells.Count = 1 And Target.Column = 5 Then
Set c = Range(Cells(Target.Row, "N"), Cells(Target.Row, "NO")).Find("Due Date")
If Not c Is Nothing Then c.ClearContents
Set c = Nothing
If IsDate(Target.Value) Then
Set c = Range("N1:NO1").Find(Target.Value)
If Not c Is Nothing Then Cells(Target.Row, c.Column).Value = "Due Date"
End If
End If
Application.EnableEvents = True
End Sub
When a date is entered in column E, this will look for that date in range N1:NO1, and if the date is found, will insert "Due Date" in the matching column of the target row.
Related
its me....again. I am currently trying to have a Macro trigger whenever a specific cell increases on a specific sheet.
After many attempts I have been able to get the Macro to trigger when the cell is changed (increasing or decreasing) but I cannot figure out a way to have this Macro trigger only when the specified cell increases in value.
I have tried to use simple Worksheet_Change with an If Then statement that calls the Macro when the cell value is changed. Again I can't get this to trigger only when the cell increases. Not sure it is possible or if I am even thinking about this is in the right way.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address "Range" Then
Call MyMacro
End If
End Sub
Thank you for any help in advance. This would be really neat and save alot of manual clicking around.
Here is the functioning Macro that I want to trigger when certain text is entered into a range.
Sub Auto_Print_Yellow_Caution()
Application.ScreenUpdating = False
Sheets("Saver").Shapes("Group 6").Copy
Sheets("Main").Select
ActiveCell.Offset(-1, 0).Select
ActiveSheet.Paste
ActiveCell.Select
Application.ScreenUpdating = True
End Sub
I already have my Workbook set up to track these words/phrases and return either a TRUE or FALSE value. If TRUE the associated Order Number is Printed into a Cell and a COUNTIFS formula is used to keep track of how many orders meet the TRUE condition. That number is then used to keep track of how many total of those orders there are. That works using the following
=IF(ISNUMBER(SEARCH("Completed",Main!G7)),TRUE)
-looks for specific word and returns TRUE
=IF(T3=TRUE,Main!A7,"")
-Returns order number
=IF(COUNTIF($U3:$U$200,"?*")<ROW(U3)-2,"",INDEX(U:U,SMALL(IF(U$2:U$200<>"",ROW(U$2:U$200)),ROWS(U$2:U3))))
-Sorts order numbers into list
=COUNTIF(T2:T135,TRUE)
-Counts number of orders
Hopefully this adds context to what I am trying to accomplish.
This will hopefully get you on the right track. As per your question it assumes this is required for a single cell only (and in this example code, that cell is B2). The trick is to store the new value, 'undo' the change, grab the old value, reverse the 'undo' by replacing the new value. Then you can test if the values are numbers and, if so, test if the new number is greater than the old number.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim newValue As Variant, oldValue As Variant
If Target Is Nothing Then Exit Sub
If Target.Cells.Count <> 1 Then Exit Sub
If Target.Column <> 2 Or Target.Row <> 2 Then Exit Sub ' example is using cell B2
Application.EnableEvents = False
newValue = Target.Value2
Application.Undo
oldValue = Target.Value2
Target.Value2 = newValue
Application.EnableEvents = True
If IsNumeric(oldValue) And IsNumeric(newValue) Then
If CDbl(newValue) > CDbl(oldValue) Then
Call MyMacro
End If
End If
End Sub
Here is some logic I can think of, you need to have a helper cell to store previous data and compare if it increased. In this sample my helper cell is B1 and the cell I want to track is A1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KCells As Range
Set KCells = Sheet10.Range("A1")' The variable KeyCells contains the cells that will
If Not Application.Intersect(KCells, Range(Target.Address)) Is Nothing Then 'cause an alert when they are changed.
If Sheet10.Range("B1").Value < Sheet10.Range("A1").Value Then
MsgBox "Replace this to call macro"
Sheet10.Range("B1").Value = Sheet10.Range("A1").Value 'this is to save the current data incase you change it later.
End If
End If
End Sub
I've already found article about how to automatically add date on a cell. I used it and change it to add time on a cell (Code below).
Dim rng1 As Range
Set rng1 = Intersect(Range("D:D"), Target)
If rng1 Is Nothing Then Exit Sub
Application.EnableEvents = False
rng1.Offset(0, -2).Value = Time()
Application.EnableEvents = True
End Sub
Question is:
How can I change code to do the same in the same sheet but in different column?
Now I entering data on column "D" and get time on column "B". I want also enter data in column "K" and get time on column "I"
Unfortunately I'm not good in coding and I don't have any idea how correctly edit this code.
I also forgot to tell that I want to use this macro on excel placed on Sharepoint website.
Can I ask you guys for help??
Best regards Christof
Since the offset D to B and K to I is -2 in both cases you can use
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 Or Target.Column = 11 Then ' D or K
Application.EnableEvents = False
Target.Offset(0, -2).Value = Time()
Application.EnableEvents = True
End If
End Sub
Whenever date is entered in column B, date before 3 business date should be automatically inserted in column C. I get it with =IF(B15, WORKDAY(B15, -3), " ") this formula but unable to get it automatically inserted for future rows without adding formula to blank cells. I need it without adding extra blank cells. Any suggestions would be appreciated
First format column C to some date format and then insert this event macro in the worksheet code area:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim B As Range
Set B = Range("B:B")
If Intersect(B, Target) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
v = Target.Value
If Not IsDate(v) Then Exit Sub
Application.EnableEvents = False
Target.Offset(0, 1) = Application.WorksheetFunction.WorkDay(v, -3)
Application.EnableEvents = True
End Sub
There will be no formulas entered in column C.
EDIT#1:
An alternative is to enter in C15:
=IF(B15="","",WORKDAY(B15,-3))
and copy down. The C cells will appear empty until the B cell is filled.
I found code to work in Excel that almost does what I need.
My need is to have today's date added automatically in one column's cell when a change is made in another column's cell. So if I click in Column M Row 20's cell & change data or add data (in this case it is a Status column with a dropdown list) then in Column N Row 20's cell it will put today's date or replace old date with today's date. (Every time Status dropdown is changed.)
This code does that for 2 different columns because I altered it.
The Problems:
If I insert rows it will put today's date in the newly inserted
rows or if I delete rows, let's say 3 rows it will add the date or
overwrite the date in the 3 rows below the 3 just deleted. This is
not good. I only want a date added if I make a change in the cell
itself. Simply auto add date when we add or change the status (Data)
in the cell to the left of it.
Also I need the top 9 rows not to be affected by this auto date
add.
Lastly if I double click in Column M Row 20's cell but do not
enter any data then click out of the cell it will still add date to
Column N Row 20's cell.
I found the original code at:
Auto-fill the date in a cell, when the user enters information in an adjacent cell
My version of the code is:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, M As Range, X As Range, Inte As Range, r As Range
Set A = Range("M:M,X:X")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Inte
r.Offset(0, 1).Value = Date
Next r
Application.EnableEvents = True
End Sub
These modification take care of your first two specifications.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M:M,X:X"), Range("10:" & Rows.Count)) Is Nothing Then
If Target.Count < Columns.Count Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim r As Range
For Each r In Intersect(Target, Range("M:M,X:X"), Range("10:" & Rows.Count))
With r.Offset(0, 1)
.Value = Now 'use Now to retain the time as well as the date
.NumberFormat = "dd-mmm-yyyy hh:mm:ss" 'change to what you prefer
End With
Next r
End If
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
As far as the third, I would humbly suggest that you get used to using the preferred method of tapping Esc to abandon an 'in-cell' edit rather than Enter↵ or selecting another cell. Using Esc does not change the value in the cell and the Worksheet_Change event macro is not triggered. Using Enter or selecting another cell DOES change the value in the cell and coding against lackadaisical practises is simply not worth the overhead when proper keyboard practises could be applied.
Addendum:
If your hand is still on the mouse, you can also click the × in the formula bar to [Esc] an in-cell edit.
Thank you in advance. I am pretty new to VBA I am trying to have a single column of cells copied from one column and pasted into a number based on a single criteria, which can change. I have a list in column E and a list in Column F. I want to be able to pull data from only certain cells in column E based on the adjacent cell in column F. Basically, whatever name I type into "L7", the macro will pull any data from column E that corresponds to that name. This is what I have so far:
Private Sub Worksheet_Change (ByVal Target As Range)
If Target.Value = "" then Exit Sub
Dim rn
rn = 15
If Target.row = 7 And Target.Column = 12 Then
For Each cel in Range("E:E")
If cel.Offset(0,1).value = cel.Value Then
Range("L" & rn).Value = cel.Value
rn = rn+1
End If
Next cel
End If
End Sub
Now, this does what I want it to do. I even works if I change the name in cell "L7". The problem is that it does not replace all the data from the previous time the macro ran. If I have a list of 20 names and 10 names and run the macro to pull the list of 20 names first, it won't clear out the extra names from that list when I pull the second.
I attempted several different things on this. I tried:
Sub Clear_cells()
Sheets("Sheet1").Range("L15:L100").ClearContents
End Sub
That didn't return any error messages but nothing happened.
I then tried:
If Range("L15:100").Value <> "" Then
Range("L15:100").ClearContents
End If
That line of code gave me a type 13 mismatch error.
Simply put, I need the entire range of cells where the data is being pasted to change and there be no leftover data from the previous time the macro ran.
Your help is much appreciated.
You can call the other macro from within your code:
Private Sub Worksheet_Change (ByVal Target As Range)
If Target.Value = "" then Exit Sub
Call Clear_Cells()
Dim rn
rn = 15
If Target.row = 7 And Target.Column = 12 Then
For Each cel in Range("E:E")
If cel.Offset(0,1).value = cel.Value Then
Range("L" & rn).Value = cel.Value
rn = rn+1
End If
Next cel
End If
End Sub
Note that this can also be done using array formulas, which I feel is a better option as code will not be run every time a cell changes on the worksheet.