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?
Related
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'm programming a table to display rows based on numeric values in one cell and text values in another (a drop down list). I completed the code for the rows, but can't seem to get my head around the columns.
Edit: What I'm trying to do is display one or two of many columns depending on what input value I have in a dropdown. At the same time as the number of rows displayed are dependent on another cell. E.g. if I have three types of candy, one per column. And in the rows I display how many of said candies I eat per day. I want to display only one of the candies, for x days. How do I code this? The row-part I solved, the column - i need help.
This is my current code, how should I go about solving my predicament?
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("Time_horizon")) Is Nothing Then
TH_row_update
TH_column_update
End If
End Sub
Public Sub TH_row_update()
Dim cell As Range
For Each cell In Range("Time_horizon_Year")
If cell.Value >= ActiveSheet.Range("Time_Horizon") Then
cell.EntireRow.Hidden = True
ElseIf cell.Value <= ActiveSheet.Range("Time_Horizon") Then
cell.EntireRow.Hidden = False
End If
Next cell
Application.ScreenUpdating = True
End Sub
Public Sub TH_column_update()
Dim cell As Range
For Each cell In Range("comparator_range")
If cell.Value = ActiveSheet.Range("Combination_comparators") Then
cell.EntireColumn.Hidden = True
ElseIf cell.Value <= ActiveSheet.Range("Combination_comparators") Then
cell.EntireColumn.Hidden = False
End If
Next cell
Application.ScreenUpdating = True
End Sub
If you want to go trough colums and cells:
For Each col In Range("comparator_range").Columns
Debug.Print "column " & col.Address
For Each cel In col.Cells
Debug.Print " - cell " & cel.Address
Next cel
Next col
So lets say your range is A1:C5
The first for each will run for each column that exists in this range mean A B C
The second for each trough every cell inside of the colum, means A1-A5, B1-B5, C1-C5
Hope this help you already, if you need more informations just tell it.
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
When data is entered (user has hit "return") into any cell in Column B, I want to insert four rows directly below the row that just had data entered into it.
I want the program to run automatically after the user has hit return on the cell. I've been having three sticking points:
Finding a way for the program to run without the user having to hit a button. I've spent a fair amount of time searching for example code to use and have found several resources, but the two examples I've used haven't seemed to work. PDCA is the sheet name, Add_Row is the macro I've written to add rows below the user-inputted data.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [B3:B14]) Is Nothing Then Sheets("PDCA Tracking").Add_Row
End Sub
Actually running the Add_Row program. I get an Error 1004 Application Defined or User Defined Error. My second question is, when the user hits return, the active cell wouldn't be the one s/he just entered data in then, would it? How would I mitigate that? It would be the last row of the spreadsheet, could I find the last row and then just add rows below that?:
Sub Add_Row'Insert row below active cell
ActiveCell.Offset(1).EntireRow.Insert
Cells(ActiveCell.Offset(1), 3).Value = "Zulu"
ActiveCell.Offset(2).EntireRow.Insert
Cells(ActiveCell.Offset(2), 3).Value = "Yankee"
ActiveCell.Offset(3).EntireRow.Insert
Cells(ActiveCell.Offset(3), 3).Value = "X-Ray"
ActiveCell.Offset(4).EntireRow.Insert
Cells(ActiveCell.Offset(4), 3).Value = "Whiskey"
'Call Merge_Cells
End Sub
After I enter the data, I want to take the cells below the row where the user just added the data and merge them. (ie if the user input "banana" and I added four rows below "banana", I want JUST the four new cells under banana to merge with the cell containing "banana". I know there's a .Merge command but again, not sure of the syntax to use.
Any and all help is very appreciated!
UPDATE: I figured out how to add data below the last filled in row, I believe.
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Cells(lastRow + 1, 3).Value = "Zulu"
Cells(lastRow + 2, 3).Value = "Yankee"
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo haveError
If Target.Cells.Count = 1 And _
Not Application.Intersect(Target, [B3:B14]) Is Nothing Then
Application.EnableEvents = False
With Target
.Offset(1, 0).Resize(4, 1).Insert Shift:=xlDown
.Resize(5, 1).Merge
.VerticalAlignment = xlTop
End With
Application.EnableEvents = True
End If
Exit Sub
haveError:
Application.EnableEvents = True
End Sub
I am quite new in excel vba and I would really appreciate if you can assist me.
The thing is that I have cell which updates each minute because it is linked with a function to Blomberg. The thing is that I want that each time cell updates excel copies it and pastes to another, new cell that i can observe the intra day changes.
I have come up with some codes but I can copy and paste only to one, similar cell.It looks like following:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("E4")) Is Nothing Then
Range("E4").Copy
Range("E4").PasteSpecial xlPasteValues
End If
End Sub
Any help would be highly appreciated.
If I understand your problem correctly you want to copy the value to a new cell, for logging purposes? What I would do in this case is have another sheet for logging the values named "logger_sheet" I paste a value in cell a1 when the blomberg cell updates, copy the value into my logger_sheet cell a2 when it changes copy it to a3 then a4 etc.
Here is your updated code. It assumes you have a sheet named "logger_sheet" (if you dont have one, create it) to store all the previous values. When the blomberg cell updates, it copies the value and pastes it to the next avaliable logging_sheet cell. I have developed a function that finds the last used row in a specified sheet and column. Try it out
Also there is a line you can uncomment if you want to prevent excel from flashing, I labeled it in the code
Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
target_cell = "E4"
col_to_log_data = "A"
logging_Sheet = "logger_sheet"
If Not Intersect(Target, Range("E4")) Is Nothing Then
'uncomment this line to stop the "flashing"
'Application.ScreenUpdating = False
'gets the name of the current sheet
data_sheet = Range(target_cell).Parent.Name
Range(target_cell).Select
Selection.Copy
'gets the next free row from column a of the logging sheet (the next free row is
'the last used row + 1)
next_free_row = GetLastRowByColumn(CStr(col_to_log_data), CStr(logging_Sheet)) + 1
'pastes the value
Sheets(logging_Sheet).Range(col_to_log_data & CStr(next_free_row)).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'switches back to the data sheet
Sheets(data_sheet).Select
'make sure you turn screen updating on (if it was never off it still works)
Application.ScreenUpdating = True
End If
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'this finds the last row in a specific column
'PARAMS: col_to_check, the clumn we want the last row of
' Opt: sheet_name, the sheet you want to check last row of
' default is current sheet if not specified
'RETURN: the last row number used in the sheet
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetLastRowByColumn(col_to_check As String, Optional sheet_name As String)
'gets current sheet name
the_current_sheet = ActiveSheet.Name
'if the user didnt' specify a sheet use the current one
If (Len(sheet_name) = 0) Then
sheet_name = the_current_sheet
End If
'gets last row
GetLastRowByColumn = Sheets(sheet_name).Range(col_to_check & "65536").End(xlUp).Row
'returns to original sheet
Sheets(the_current_sheet).Select
End Function
If my answer solves your problem please mark it as the solution
How about this? It will transfer E4 to Sheet2 in a new row each time E4 changes.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Address = "$E$4" Then Sheets("Sheet2").Cells(Rows.Count, "F").End(xlUp).Offset(1) = Target
End Sub
I'm making the assumption you want to log every change of values.
I would advise to keep a log in a separate sheet. Let's call it LogSheet.
Sub WriteLog(ByRef r As range)
Dim Lastrow as integer
With ThisWorkBook.WorkSheets("LogSheet")
LastRow = .Cells(.Rows.Count,"A").End(XlUp).Row
.Range("A" & LastRow + 1).Value = Now & " - " & r.Value
End With
End Sub
This sub will basically write all changes in column A of our log sheet with a timestamp!
Now, we need to make changes to your code in order to tell, to make logs whenever there is a change. To do so, we're going to make a call to our function and tell to copy the content of the range("E4") (The one that gets updated all the time)
If Not Intersect(Target, Range("E4")) Is Nothing Then
'add this line
WriteLog(ActiveSheet.Range("E4"))
Try it now.