VBA to leave cells blank

[aldocious]

I am currently running the following VBA:

Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 8 Then
Target(1, -3) = Time
Target(1, -2) = Date
End If

End Sub

What it does is when any changes are made to column "8" (Column H), column D is inputed with the time and E is inputed witht he date. What I'd like to do is only when column "8" (H) as the letter "a" inserted does the time and date get stamped onto their respective cells. Also if H is blank to leave or clear anything in the respective cells of D and E. Can anyone help with this VBA?! THanks

 

[Peter_SSs]

Welcome to the MrExcel board!

See if this does what you want.

<font face=Courier New><br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_Change(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>    <SPAN style="color:#00007F">Dim</SPAN> Hchanged <SPAN style="color:#00007F">As</SPAN> Range, Cel <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    <SPAN style="color:#00007F">Set</SPAN> Hchanged = Intersect(Target, Columns("H"))<br>    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> Hchanged <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>        <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> Cel <SPAN style="color:#00007F">In</SPAN> Hchanged<br>            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> Cel.Value<br>                <SPAN style="color:#00007F">Case</SPAN> vbNullString<br>                    Cel.Offset(, -3).Resize(, 2).ClearContents<br>                <SPAN style="color:#00007F">Case</SPAN> "a"<br>                    Cel.Offset(, -3).Value = Time<br>                    Cel.Offset(, -2).Value = <SPAN style="color:#00007F">Date</SPAN><br>                <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN><br>    <br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN><br>        <SPAN style="color:#00007F">Next</SPAN> Cel<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br></FONT>

 

[aldocious]

WOW!! THank you very much. It works great. I neglected to indicate that the column where "a" is inputed isn't only on column "H" but H, O, V, AC, AJ, AQ, AX and BE so that when an "a" is inputed into these columns the cel.offset (, -3).value = Time and cel.Offset(, -2) = Date. Is there something I can copy and paste to make it work with all those columns?

Thanks again for all your help.

 

[aldocious]

 

[aldocious]

So this is what I was able to come up with for each column. THe problem I'm having now is, if I highlight the column "H" where a's are inputed into to clear them all, it just freezes. Any thoughts


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Hchanged As Range, Cel As Range

Set Hchanged = Intersect(Target, Columns("H"))
If Not Hchanged Is Nothing Then
For Each Cel In Hchanged
Select Case Cel.Value
Case vbNullString
Cel.Offset(, -4).ClearContents
Cel.Offset(, -3).ClearContents
Case "a"
Cel.Offset(, -4).Value = Time
Cel.Offset(, -3).Value = Date
Case Else

End Select
Next Cel
End If

Set Hchanged = Intersect(Target, Columns("O"))
If Not Hchanged Is Nothing Then
For Each Cel In Hchanged
Select Case Cel.Value
Case vbNullString
Cel.Offset(, -4).ClearContents
Cel.Offset(, -3).ClearContents
Case "a"
Cel.Offset(, -3).Value = Time
Cel.Offset(, -2).Value = Date
Case Else

End Select
Next Cel
End If
End Sub

 

[Peter_SSs]

I neglected to indicate that the column where "a" is inputed isn't only on column "H" but H, O, V, AC, AJ, AQ, AX and BE so that when an "a" is inputed into these columns the cel.offset (, -3).value = Time and cel.Offset(, -2) = Date. Is there something I can copy and paste to make it work with all those columns?

You don't need a separate section per column. See my code below.

THe problem I'm having now is, if I highlight the column "H" where a's are inputed into to clear them all, it just freezes. Any thoughts

Yes, I have three thoughts:

1. Largely my fault.
When changing cells on the sheet in a Worksheet_Change event code you need to disable events. Otherwise when the code changes a cell (say by entering the date in a cell to the left) that is a change to the worksheet so the Worksheet_Change code is triggered again when it is not necessary. So every time an "a" is entered or a cell "Deleted" the code will be called 3 times instead of once.

2. If a large number of cells is to be processed, code will run much quicker if ScreenUpdating is turned off during the process. Again, I should have already had that in my code.

3. If you are using Excel 2007+ and you select the whole column and delete, the code has 1,048,576 cells to check/process. That will take a fair amount of time no matter what. Even with the improved code below and a reasonably new machine it takes about 40 seconds to process a whole column on my machine in Excel 2010. So it would be best to try not to use whole columns if you don't need to.


So try replacing the previous code with this:

<font face=Courier New><br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_Change(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>    <SPAN style="color:#00007F">Dim</SPAN> Changed <SPAN style="color:#00007F">As</SPAN> Range, Cel <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    <SPAN style="color:#00007F">Const</SPAN> myCols <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "H:H, O:O, V:V, AC:AC, " _<br>        & "AJ:AJ, AQ:AQ, AX:AX, BE:BE"<br>    <br>    <SPAN style="color:#00007F">Set</SPAN> Changed = Intersect(Target, Range(myCols))<br>    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> Changed <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>        Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br>        Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>        <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> Cel <SPAN style="color:#00007F">In</SPAN> Changed<br>            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> Cel.Value<br>                <SPAN style="color:#00007F">Case</SPAN> vbNullString<br>                    Cel.Offset(, -3).Resize(, 2).ClearContents<br>                <SPAN style="color:#00007F">Case</SPAN> "a"<br>                    Cel.Offset(, -3).Value = Time<br>                    Cel.Offset(, -2).Value = <SPAN style="color:#00007F">Date</SPAN><br>                <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN><br>    <br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN><br>        <SPAN style="color:#00007F">Next</SPAN> Cel<br>        Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br>        Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br></FONT>