New to VBA
thanx in advance..
is it possible to automatically undo changes to a row range depending on another corresponding cell value?
for example :
cells A2,B2,C2 are the cells that user inter data within
Cell G2 the cell which the auditor Approve the interned data on the raw by typing "yes"
so if G2 value is "yes" any change to the values in A2,B2,C2 is canceled "undo" and return to its original data,
if G2 is not "yes" then user can alter the value in cells A2,B2,C2 as he wants
and that goes for the other cells in sequnce A3,B3,C3 versus G3, A4,B4,C4 versus G4 and so on...
Code copied from comment:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo er1
Application.EnableEvents = False
If Not Intersect(Target, Range("A1:d10")) Is Nothing Then
If Target.Range("g1:g10").Value = "Yes" Then
Application.Undo
Else
End If
End If
err2:
Application.EnableEvents = True
Exit Sub
er1:
MsgBox Err.Description
Resume err2
End Sub
The problem is in the code where you are trying to check if column G is "Yes":
If Target.Range("g1:g10").Value = "Yes" Then
Application.Undo
Else
End If
The Target variable is already a range and will not be column G if the user has entered something in columns A-D. Instead, you must work out the row number which has just been changed and then look at column G for that row. Replace your block of code with this:
Dim rowNumber As Long
' This **assumes** only 1 cell has been changed
rowNumber = Target.Row
If Target.Parent.Cells(RowIndex:=rowNumber, ColumnIndex:="G").Value = "Yes" Then
Application.Undo
Else
End If
Warning This code assumes that only one cell has been changed. If you think that Target might be more than one cell, you should loop through the cells checking them all:
Dim rowNumber As Long
Dim cell As Range
For Each cell In Target.Cells
rowNumber = cell.Row
If Target.Parent.Cells(RowIndex:=rowNumber, ColumnIndex:="G").Value = "Yes" Then
Application.Undo
Exit For
Else
End If
Next cell
Related
I have a sheet and the user input Starts in A7 and calculations are inserted with a macro to B7 all the way through I.
I got all that worked out but what i need is: the user is going down typing in data in Column A, lets say they input data Starting from A7, through A11, then skip A12 and type into A13, i want the sheet to automatically move the user's input into A12 so there's never any blank rows IN BETWEEN the data in column A.
Ideally all the data should be in sequence and there shouldn't be any blank rows in between the data entered in column A.
Here is the code i have come up with thus far:
Private Sub worksheet_change(ByVal Target As Range)
Dim r As Integer
Dim c As Integer
1 If Not Intersect(Target, Range("A:C")) Is Nothing Then
If Target.Row >= Range("FormulaRange").Row + 1 Then
If Target.Row <= Range("RowTracker").Value + 1 Then
Dim t
RWS = Target.rows.Count
COLS = Target.Columns.Count
For r = 1 To RWS
For c = 1 To COLS
If Not IsNumeric(Target.rows.Cells(r, c).Value) Then
'Else
MsgBox "Please enter only numeric values."
Application.Undo
'End
Else
If Target.rows.Cells(r, 2) = "" Then Target.rows.Cells(r, 2) = 0
If Target.rows.Cells(r, 3) = "" Then Target.rows.Cells(r, 3) = 0
End If
Next c
Next r
Else
MsgBox "Please enter data in the next available line."
Exit Sub
End If
End If
End If
End Sub
Right now it detects if i skip rows and input arbitrarily in A giving me a warning not to do so but i would love it just took my input and put it back into the next available row in column A.
I thought about doing a Row.Delete but the way the code is set up is keeps detecting the deleted row as skipping cells in A column continuously giving me the error of "Please Enter Data in the next available line."
Key point missing is to prevent a cascade of events as you change the sheet. Use Application.EnableEvent = False to prevent this.
Then deleting rows with blanks will work, something like this
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rw As Long
Dim i As Long, j As Long
On Error GoTo EH
If Not Application.Intersect(Target, Me.Columns("A:C")) Is Nothing Then
rw = Me.Cells(Me.Rows.Count, 1).End(xlUp).Row
' Prevent a cascade of events
Application.EnableEvents = False
For i = rw To 1 Step -1
'Check for blanks in column A, delete row if found
If IsEmpty(Me.Cells(i, 1)) Then
Me.Rows(i).Delete
End If
'check for non numeric data
For j = 1 To 3
If Not IsNumeric(Me.Cells(i, j)) Then
Me.Cells(i, j).ClearContents
End If
'Enter Zeros's
If j > 1 Then
If IsEmpty(Me.Cells(i, j)) Then
Me.Cells(i, j) = 0
End If
End If
Next
Next
End If
EH:
' restore event handling
Application.EnableEvents = True
End Sub
Notes:
The delete rows and check for non numeric/blanks will interact, possibly in ways you don't expect
If user leaves column A blank and enters data into other columns, it will be deleted
I've left out the Named Range checks, as I'm unsure what they are doing. You can reinstate to suit.
Might be better to validate and warn the user before deleting
Something like this will force the user to only stay in the next possible row for column A without being able to enter more information.
This isn't foolproof, but will get you started. You can extend as needed:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 And Target.Row <> 1 Then
If Len(Target.Offset(-1)) = 0 Then
Target.Offset(-1).Select
End If
End If
End Sub
I need help with an macro to notify me (by changing a cell background color to red), when the value (always number format) changes in any cells in the row. I want the background of cell E3 to change to red, if any of the values in cells F3:AN3 change from their current values.
The numbers in cells F3:AN3 will be entered manually or thru copy and paste of the row, and there won't be any formulas. Likewise, if any values in cells F4:AN4 are changed, I would like cell E4 to change to a red background, and so on for each of the rows in the chart. Not all rows will always have a value, so I would be looking for changes from "" to any #, or from one # to another #, or from any # to "". Ideally this would be an event macro that does not have to be run manually.
The following is the code I've started working with:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F3:AN3")) Is Nothing Then KeyCellsChanged
End Sub
Private Sub KeyCellsChanged()
Dim Cell As Object
For Each Cell In Range("E3")
Cell.Interior.ColorIndex = 3
Next Cell
End Sub
However, this macro seems to run regardless of whether the number in the cell is changed, as long as I press enter it highlight E3 as red.
Any help is much appreciated!
Here is my favorite way to detect changes in an Excel VBA app:
Create an exact copy of the range you're watching in hidden rows below the range the user sees.
Add another section below that (also hidden) with formulas subtracting the user range with the hidden range with an if statement that sets the value to 1 if the difference is anything but 0.
Use conditional formatting in the user range that changes the background color of the row if the corresponding change-detection row (or cell) is > 0.
What I like about this approach:
If a user makes a change and then reverts back to the original value, the row is "smart enough" to know that nothing has changed.
Code that runs any time a user changes something is a pain and can lead to problems. If you set up your change detection the way I'm describing, your code only fires when the sheet is initialized. The worksheet_change event is expensive, and also "may effectively turn off Excel’s Undo feature. Excel’s Undo stack is destroyed whenever an event procedure makes a change to the worksheet." (per John Walkenbach: Excel 2010 Power Programming)
You can detect if the user is navigating away from the page and warn them that their changes will be lost.
Depending on your answer to my question in the comments, this code may change. Paste this in the relevant Worksheet code area. For this to work, navigate to any other sheet and then navigate back to the original sheet.
Option Explicit
Dim PrevVal As Variant
Private Sub Worksheet_Activate()
If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
PrevVal = Selection.Value
Else
PrevVal = Selection
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo ExitGraceFully
If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
PrevVal = Selection.Value
Else
PrevVal = Selection
End If
ExitGraceFully:
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.WorksheetFunction.CountA(Target) = 0 Then Exit Sub
Dim aCell As Range, i As Long, j As Long
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Columns("F:AN")) Is Nothing Then
If Target.Rows.Count = 1 And Target.Columns.Count >= 1 Then
Range("E" & Target.Row).Interior.ColorIndex = 3
ElseIf Target.Rows.Count > 1 And Target.Columns.Count = 1 Then
i = 1
For Each aCell In Target
If aCell.Value <> PrevVal(i, 1) Then
Range("E" & aCell.Row).Interior.ColorIndex = 3
End If
i = i + 1
Next
ElseIf Target.Rows.Count > 1 And Target.Columns.Count > 1 Then
Dim pRow As Long
i = 1: j = 1
pRow = Target.Cells(1, 1).Row
For Each aCell In Target
If aCell.Row <> pRow Then
i = i + 1: pRow = aCell.Row
j = 1
End If
If aCell.Value <> PrevVal(i, j) Then
Range("E" & aCell.Row).Interior.ColorIndex = 3
End If
j = j + 1
Next
End If
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
Resume LetsContinue
End Sub
SNAPSHOTS
It works as expected When you type a value in the cell. It also works when you copy 1 Cell and paste it in multiple cells. It doesn't work when you copy a block of cells and do a paste (I am still working on this)
NOTE: This is not extensively tested.
I have a sheet called "JE", and in column C (C7:C446) users are able to populate the cells with account codes by two methods:
Double-clicking codes on a separate sheet called acct_codes
Manually enter the codes in column C. When the user manually enters the account code in column C, it is checked and changed to #N/A if it isn't listed in the acct_codes sheet to indicate to the user the code they entered was incorrect.
Column E is an account description column it will show the description associated with the account code in column C.
As it is now, the next available cell is the next blank cell in column C. I would like to make any cell in column E that equals #N/A to be the next available cell, THEN the next blank cell can be the next available cell.
For example if cell E11 has a value of #N/A, then the next time a user navigates to the acct_codes sheet and double-clicks a valid account code, I would like the account code they clicked to overwrite and populate C11.
I am unsure of the syntax to accomplish this and am having a hard time finding good example of this online. If anyone knows of a way I can go about doing this, I'd greatly appreciate it.
Here is the code I have in the acct_codes sheet:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim acctDesc As Range
Set acctDesc = Range("E7:E446")
If Target.Column = 1 Then
For j = 7 To 447
If Worksheets("JE").Range("C" & j).Value = "" Then
Worksheets("JE").Range("C" & j).Value = ActiveCell.Value
Worksheets("JE").Activate
Exit For
End If
Next j
End If
For Each Cell In acctDesc
If Cell.Value = "#N/A" Then
'Make that next available cell'
'else make next blank cell next available'
End If
Next Cell
Cancel = True
End Sub
EDIT
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim NextAvailableCell As Range
With ThisWorkbook.Sheets("JE")
Set NextAvailableCell = .Range("C7:C447").Find(What:="#N/A", _
LookAt:=xlWhole, _
LookIn:=xlValues)
If NextAvailableCell Is Nothing Then
Set NextAvailableCell = .Range("C7:C448").End(xlUp).Offset(1, 0)
.Cells(NextAvailableCell.Row, "C").Value = Target.Value
End If
End With
NextAvailableCell.Value = Target.Value
Cancel = True
Call Back_to_JE 'calls a macro that brings user back to main form/sheet "JE"
End Sub
It would be much quicker to use Find
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim NextAvailableCell As Range
With ThisWorkbook.Sheets("JE")
' Set equal to next "#N/A" cell
Set NextAvailableCell = .Range("C7:C447").Find(What:="#N/A", _
LookAt:=xlWhole, _
LookIn:=xlValues)
' If no "#N/A" cell was found then get last empty cell in column,
' assuming it's above C448
If NextAvailableCell Is Nothing Then
Set NextAvailableCell = .Range("C448").End(xlUp).Offset(1, 0)
End If
End With
' Assign value of double clicked cell
NextAvailableCell.Value = Target.Value
' Make it so that the double clicker doesn't enter the cell
Cancel = True
End Sub
This also avoids activating and selecting, which is good practise.
I'm unsure which cell you want to write to. If you want to search for #N/A in column E instead of column C, simply change that in the .Range(___).Find line. Ditto for the next blank cell in the relevant line.
If you want to write to a specific column, say column E, then use something like
' Inside the With block for ThisWorkbook.Sheets("JE")
.Cells(NextAvailableCell.Row, "E").Value = Target.Value
I'm attempting to create a worksheet macro that will populate specific cells with default values in the same row when a value is entered in the first column of the row and also copy an entered value from the same row into other cells in that row. For example, when the user enters some value in 2A, cells 2C and 2D automatically populate with the numbers 10 and 20 respectively. Then, when the user enters a value in 2S, that same value is automatically copied back to cells 2I and 2J.
Thanks for the additional info Ralph. Based off of what I've found through researching similar questions on stackoverflow and general internet searches, I put together the following:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, S As Range, InteA As Range, InteS As Range, r As Range
Set A = Range("A:A")
Set S = Range("S:S")
Set InteA = Intersect(A, Target)
Set InteS = Intersect(S, Target)
Application.EnableEvents = False
If Not InteA Is Nothing Then
For Each r In InteA
r.Offset(0, 2).Value = "10"
r.Offset(0, 3).Value = "20"
Next r
ElseIf Not InteS Is Nothing Then
For Each r In InteS
r.Offset(0, -9).Value = Target
r.Offset(0, -10).Value = Target
r.Offset(0, -11).Value = Target
Next r
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
To get a macro to run, an event of some kind has to occur. Its tempting to try to run a macro whenever ANY change is made to the worksheet, but imagine how often that's going to trigger? All the time. Then you have to worry if 10 & 20 will start flying into those cells when you don't want them to and write some conditional code to skip the process if you aren't typing in column A...
So here's a different option you might prefer. Enter formulas in columns C and D that will result in 10 & 20 if data exists in A.
=IF(A2<>"",10,"") or =IF(ISNUMBER(A2),10,0) ...whatever you like.
Then select your header row and data row, convert to an real "Excel table" on the Insert menu. (Insert...Table) This will extend your formulas to new rows as you type into column A.
Macro averted?
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.