I have been trying to work this out myself for the last few days and caught myself in a bit of a one step forward three steps back cycle. I've been reluctant to bother you thinking this would have been answered somewhere else before now.
The idea is that I have a spreadsheet that has criteria in rows with separate entries in rows; in row 6 it is the status of each column entry, which when changed to "Completed" I would like the column to be hidden.
I've been floundering around with Worksheet_Change and been able to hide specific columns, but not the active column.
Any help offered would be much appreciated and I'm sorry if this has been covered elsewhere, but I've not been able to successfully apply any examples out there.
Thanks.
Whenever you have to work with worksheet_change events, you have to consider a cycle for it, due to user may delete multiple data at the same time or do a copy paste, if you only consider "Target" It would give a debugger error.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ItemMultipleData As Range
For Each ItemMultipleData In Target 'handles multiple cells, paste, del, etc
'your code (instead of using "Target" change to ItemMultipleData. IE:
'If ItemMultipleData.Value = "Completed" Then
Next ItemMultipleData
End Sub
Here is a starting point. It only checks row # 6:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("6:6")
If Intersect(Target, rng) Is Nothing Then Exit Sub
If Target.Count <> 1 Then Exit Sub
If Target.Value = "Completed" Then
Application.EnableEvents = False
Target.EntireColumn.Hidden = True
Application.EnableEvents = True
End If
End Sub
EDIT#1:
This approach assumes that only one cell at a time is being changed........that makes it easy to "find the active cell"
Related
I'm trying to add timestamps for any modifications made to all rows in a table. I have been able to find/modify some code that will add the timestamp, but it does it for every cell in that column. As you can see it's got a line that tells it to start below a certain row. I want to make this apply only to the tables in each worksheet in my excel file. This would include any new tables added to the sheets. I'm very new to VBA, so any and all constructive help is welcome!
A little background: These sheets are being used for resource forecasting for my company for every different project we have going on. And every crew in each project has their own table. The forecasts get updated each week. I want to be able to quickly find what has changed when I get these at the end of the week. This isn't meant to be a permanent solution for our forecasting needs, but it will make my life easier in the meantime.
This is the code I've been working with. As I mentioned I know this only does part of what I want. I was trying to modify it to do what I want, but I just don’t have the know how yet:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, c As Range
Const DateStampColumn As Long = 2
'Date stamp column number
For Each r In Target.Rows
If r.Row > 10 Then
For Each c In r.Cells
If Not IsEmpty(c) Then
Application.EnableEvents = False
Cells(r.Row, DateStampColumn).Value = Date
Application.EnableEvents = True
Exit For
End If
Next c
End If
Next r
End Sub
I was able to modify it to do what I needed. I removed the message box lines because I think that will frustrate the users entering the data (I'm the one that has to extract it). There is one issue that I'm hoping you could help me solve. Whenever I add or delete a row within the tables a timestamp appears. Is there a way to keep that from happening? Here is what my code looks like currently:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As ListObject
For Each t In ActiveSheet.ListObjects
If Not Intersect(Target, t.DataBodyRange) Is Nothing Then
Application.EnableEvents = False
Cells(Target.Row, "B").Value = Date
Application.EnableEvents = True
Exit Sub
End If
Next t
End Sub
You need something along these lines I think. This checks whether Target is in a table, I haven't added the Date as I'm not sure where it should go.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As ListObject
For Each t In ActiveSheet.ListObjects
If Not Intersect(Target, t.DataBodyRange) Is Nothing Then
MsgBox "Cell changed in " & t.Name
Exit Sub
End If
Next t
MsgBox "Cell changed not in any table"
End Sub
I want to calculate a price based on a proposed discount % or calculate a discount based on a proposed price.
I need users to be able to use either parameter and adjust back and forth to determine their ideal price.
I have coded the formulas so that nothing is overwritten by the user but have a problem as the 'value if false' element of the "IF" formula is dependent on a zero value in one column and so resets if the user doesn't manually adjust this before inputting a figure into another. This results in the new figure being reset.
Ideally I would like the sheet to reset the value in column "Proposed Promo POR%" to zero if a value is input in "Promo Price per Unit". Is this possible?
This is the code I have at the moment.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("b21:b26")) Is Nothing Then Exit Sub
Application.EnableEvents = False
ActiveSheet.Range("$i21:$i26").Formula ="=IF(Proposal!$b21>Formulae!$a$5,Proposal!$g21-(Proposal!$g21*Proposal!$b21), (Proposal!$g21-Proposal!$i21)/Proposal!$g21)"
Application.EnableEvents = True
End Sub
For clarity Formulae!$a$5 is zero and it is column $i21:$i26 that the user will enter a price in if they want to. If they do enter something here then column b should reset to zero.
This is a screenshot of the columns and headers in my sheet
The Worksheet_Change event will help you. Worksheet_SelectionChange fires each time a user changes the active cell, whereas Worksheet_Change fires anytime a user makes an edit to any cell(s).
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("$i21:$i26"")) Is Nothing _
And Target.Rows.Count = 1 and Target.Columns.Count = 1 Then
'assumes event will fire only on changing one cell at a time
Application.EnableEvents = False
Target.Offset(0,-7).Value = 0
Application.EnableEvents = True
End If
End Sub
First off, I'm a noob when it comes to Macros and VBA, so please forgive me if I don't make sense.
I've got an Excel spreadsheet which is basically a list of users and their mobile phone numbers and some other bits (columns A-K are currently used) and it's ordered by rows.
What I need is a way of copying the whole row if I change a cell. So if I change the username, it copies the whole row of that user to the next blank row on a second sheet.
The purpose of this is to keep an audit trail allowing us to see who's previously used a number etc.
I found this: Copy row to another sheet in excel using VBA which is working as intended, but I can't for the life of me get it to a, copy the cells to the next free row, or b, not overwrite the existing entry.
This is the code I'm using:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Range, rw As Range
For Each a In Selection.Areas
For Each rw In a.Rows
If rw.Row >= 2 Then
rw.EntireRow.Copy Sheet2.Cells(2 + (rw.Row - 2) * 3, 1)
End If
Next rw
Next a
End Sub
I'd really appreciate it if someone could help me customise it.
I'm using Excel 2010 on Win7.
Many thank in advance.
Typically the Intersect method is used to determine if the cell or cells receiving a change involve one or more columns that you are concerned with. You can add additional parameters; in this case, I've .Offset the Worksheet.UsedRange property down one row to make sure that row 1 is not involved.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(1), Me.UsedRange.Offset(1, 0)) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False 'not really necessary in this case but never a bad idea within a Worksheet_Change
Dim a As Range
For Each a In Intersect(Target, Columns(1), Me.UsedRange.Offset(1, 0))
If CBool(Len(a.Value2)) Then _
a.EntireRow.Copy _
Destination:=Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 'not really sure this is the correct destination
Next a
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
I've included a call to disable event handling for the duration of the Worksheet_Change event macro. While this is a critical step when the Worksheet_Change modifies values, it is not really important to incorporate here. However, it does not harm and is already in place in case you want to augment the Worksheet_Change to include something like a timestamp that would change the values on the worksheet.
I have a two (very long) TO-DO lists- one going across and the other going down.
What i want to achieve is for a blank cell to appear at the start of the list instead of having to scroll to the end of the lists to enter a new item.
So then when i have entered an item in a cell and hit enter, i want the cell just populated to move down the list (or across if i hit tab) and a new empty cell to appear at the start of the list.
It would be useful for the new blank cell to be pre-populated with the current date but that is not essential.
Thanks for your help.
NOT FOR POINTS.
Piggy-backing on Gary's answer, the mistake is that you set A to Range("C4:C6"). What happens is, when you enter data into any of C4, C5, and C6, they are all moved to the right because of A.Insert, which refers to all the cells assigned to A.
The trick here is to fully qualify your requirements for Target. Let's say you have a table from B1:E3, like below:
Now, let's say you want to move row 1 if you enter something into A1, row 2 if A2, etc. The following macro should do it (notice the difference with Gary's macro):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim QualifyingRange As Range
'Dim OrigRng As String
Set QualifyingRange = Range("A1:A3")
If Intersect(Target, QualifyingRange) Is Nothing Then Exit Sub
Application.EnableEvents = False
'OrigRng = Target.Address
Target.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'Range(OrigRng).Value = Date
Application.EnableEvents = True
End Sub
What is the difference in the above? Very simple but very important. When a Worksheet_Change is in a sheet's code, every time you do a valid change to the sheet, the macro fires. The range you just edited will be known to the macro as Target. Now, usually, if you don't declare what the qualifications for Target are, the Worksheet_Change macro just fires indiscriminately. How do we qualify Target properly then?
We use Intersect. First, we declare a range of cells that we want to track. These cells, when changed, should fire the macro. Otherwise, macro is kaput. This line: If Intersect(Target, QualifyingRange) Is Nothing Then Exit Sub basically reads: If Target is not inside my desired range, then nothing happens.
This is the reason why I declared A1:A3 as my QualifyingRange. This way, if my change is to any of the cells above, the macro will fire. HOWEVER, .Insert should not be applied to the whole range but to Target alone. This is because if we do QualifyingRange.Insert, every time a change is detected in any cells in A1:A3, all three rows will move. This is what happened when you set A to three cells and kept A.Insert.
Hopefully, this clears up the confusion. Let us know if this helps.
Here is a partial solution. The following event macro monitors entry to cell A1 . Once you have entered a value in A1, the macro "pushed" the values in column A down by one. This means that value you just entered has been pushed down to A2 and A1 is empty:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range
Set A = Range("A1")
If Intersect(A, Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
A.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Application.EnableEvents = True
End Sub
Because it is worksheet code, it is very easy to install and automatic to use:
right-click the tab name near the bottom of the Excel window
select View Code - this brings up a VBE window
paste the stuff in and close the VBE window
If you have any concerns, first try it on a trial worksheet.
If you save the workbook, the macro will be saved with it.
If you are using a version of Excel later then 2003, you must save
the file as .xlsm rather than .xlsx
To remove the macro:
bring up the VBE windows as above
clear the code out
close the VBE window
To learn more about macros in general, see:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
and
http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx
To learn more about Event Macros (worksheet code), see:
http://www.mvps.org/dmcritchie/excel/event.htm
Macros must be enabled for this to work!
EDIT#1
To push across rather than down:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range
Set A = Range("A1")
If Intersect(A, Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
A.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Application.EnableEvents = True
End Sub
To handle multiple cells, you must specify which cells get pushed across and which cells get pushed down.
I have a worksheet with many dependant dropdowns that are liable to having invalid data if the initial drop down is altered. I would like a simple auto-macro that would automatically run the "circle invalid data" command every time a cell change within a specified range (D8:T800) is detected.
It sounds fairly straightforward but I am not sure how to do this.
Question - as this macro will run every single time a cell is amended would this macro slow down the worksheet?
EDIT:
Also: as this might be slow,is there a way we can run this command over a selected range?
Your thoughts thanks.
Try this
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("D8:T800")) Is Nothing Then
Me.CircleInvalid
End If
End Sub
Note that CircleInvalid applies to the whole sheet, so while this code only triggers when a cell inside D8:T800 changes, all invalid cells on the sheet will be circled
Try placing this code inside your Worksheet:
Private Sub Worksheet_Change(ByVal Target As Range)
' Check target range has changed
If (Not Intersect(Target, Range("D8:T800")) Is Nothing) Then
' Prevent recusrive looping
Application.EnableEvents = False
' Refresh validation circles
Target.Worksheet.CircleInvalid
Application.EnableEvents = True
End If
End Sub
Note that this will NOT work if the values in those cells change due to a calculation from outside the specified range.
Also, the CircleInvalid method applies to the whole worksheet.
You could try editing the code in the conditional to 'do something' if the Target is validated — this would result in you changing the format of invalid cells instead of having the red circles around them.
**PSEUDO-CODE**
For each cell in Target.Range
cell.colour = bright red
Next cell