I am trying to create a workbook where if I change a dropdown on 1 sheet, it automatically updates that same dropdown on a second sheet. These dropdowns will represent different scenarios and my purpose in creating this is to allow the end-user the ability to change the scenario dropdown from any sheet, rather than just one.
I used this reference to create a VBA for changing 1 dropdown -Original VBA code referenced - and it worked correctly (See example workbook to download). However, now I want to add the other 2 dropdowns so that if any changes are made to them it updates accordingly.
I'm also open to other solutions if you know of something better.
Sorry if this question was elementary -- I am new to VBA.
Using the example from the Original VBA code referenced, if you were looking to apply this rule to 2 sets of drop downs (4 total), instead of 1 set - you would duplicate the snippet from "If Not Intersect(..." to "..End if" and then update the reference to the 2nd set of cells.
EXAMPLE:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim targetSheet As Worksheet
If Not Intersect(Target, Range("A1")) Is Nothing Then ' watch only cell A1
Set targetSheet = ActiveWorkbook.Worksheets("Sheet2") ' define the sheet to copy to
On Error Resume Next
Application.EnableEvents = False
targetSheet.Range("B1") = Target.Value ' copy to cell B1 on the target sheet
Application.EnableEvents = True
End If
If Not Intersect(Target, Range("A2")) Is Nothing Then ' watch only cell A1
Set targetSheet = ActiveWorkbook.Worksheets("Sheet2") ' define the sheet to copy to
On Error Resume Next
Application.EnableEvents = False
targetSheet.Range("B2") = Target.Value ' copy to cell B1 on the target sheet
Application.EnableEvents = True
End If
End Sub
You would then repeat for the other worksheet.
Related
I am trying to use the Workbook_SheetChange feature of excel. I want to have multiple worksheets feed information into a master worksheet, and if you update a cell in a source sheet, the corresponding cell in the master sheet will also change, and vice versa.
Currently, I am starting small with just trying to get this thing to work with one cell so I can build on this. The code I have works, but only in one direction; when I edit something in the source sheet, the cell value in the master sheet changes to that new value. However, when I try to change the value in the master sheet, the value in the master sheet kinda bounces around until it finally decides to stick to the value derived from the source sheet. This only occurs whenever I try to have the cell portion of the address be the same between the two sheets; if the target cell in Sheet1 is $A$1 and the target cell in Sheet2 is any cell that is not $A$1, then there are no issues. This issue only occurs if the cell in both sheets is the same.
Below is the code that I am currently using.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
cell_1 = Worksheets("Sheet1").Range("$R$3").Address
cell_2 = Worksheets("Sheet2").Range("$R$3").Address
If Target.Address = cell_1 Or Target.Address = cell_2 Then
Call cellUpdate(Target.Address)
End If
End Sub
Sub cellUpdate(Target As String)
cell_1 = Worksheets("Sheet1").Range("$R$3").Address
cell_2 = Worksheets("Sheet2").Range("$R$3").Address
Application.EnableEvents = False
With ActiveWorkbook
If Target = cell_1 Then
Worksheets("Sheet2").Range("$R$3").Value = Worksheets("Sheet1").Range(Target)
ElseIf Target = cell_2 Then
Worksheets("Sheet1").Range("$R$3").Value = Worksheets("Sheet2").Range(Target)
End If
End With
Application.EnableEvents = True
End Sub
How do I get around this issue? I couldn't find any information online on how to avoid this since the uses I found for this Workbook_SheetChange function are for things that occur in one sheet rather than multiple sheets.
What is happening here is that you extensively use Target.Address. The issue with this is that Target.Address only returns the cell address, not the sheet it is on. For example it would return $A$1. Not Sheet1!$A$1. This means that in your if statement it tests whether "$A$1" = "$A$1" regardless of which sheet this address is on. Therefore it will only ever run the first clause of this loop resulting in it only working one way.
Secondly, you have a lot of redundant code, hard-coding a bunch of addresses multiple times. This can be massively simplified as demonstrated below:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim cell_1, cell_2 As Range
Set cell_1 = Worksheets("Sheet1").Range("$R$3")
Set cell_2 = Worksheets("Sheet2").Range("$R$3")
Application.EnableEvents = False
If Target = cell_1 Then
cell_2.Value = cell_1.Value
ElseIf Target = cell_2 Then
cell_1.Value = cell_2.Value
End If
Application.EnableEvents = True
End Sub
This code uses the first and second cell as range which stores the entire cell in memory, address, values, the lot. It then switches off EnableEvents as you did (good effort by the way, to prevent yourself from getting stuck in an infinite loop as most people would with this kind of code). Then it checks whether your target cell is cell 1 and switches the value of cell two with cell one, and the same for cell 2. No need for a separate function.
Couple of observations:
Worksheets("Sheet1").Range("$R$3").Address will always return the string $R$3, as will Worksheets("Sheet2").Range("$R$3").Address.
Both lines return exactly the same thing - it doesn't care what sheet it's on.
The Call statement isn't required.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
'Address is R3 on whichever sheet you're changing.
If Target.Address = "$R$3" Then
'Figure out which sheet was changed and update as required.
Select Case Sh.Name
Case "Sheet1"
Worksheets("Sheet2").Range("R3") = Sh.Range("R3")
Case "Sheet2"
Worksheets("Sheet1").Range("R3") = Sh.Range("R3")
Case "Sheet3", "Sheet4"
'Do stuff if you're on sheet 3 or sheet 4.
Case Else
'Do stuff if you're on any other sheet.
End Select
End If
Application.EnableEvents = True
End Sub
My main goal is to be able to autofilter merged cells in one column.In the picture below I want row 7-9 to disappear when I remove "6" from the autofilter menu. But as I have figured, I need the value "6" to be held in all the cells "L7:L9" in order for Excel to do so.
The number 6 is calculated by adding "Num1" and "Num2" (2 * 3) by the following function I have placed in "L7":
Function Exposure(arg1 As Range, arg2 As Range) As Variant
Application.EnableEvents = False
Application.Calculation = xlManual
If Application.ThisCell.Offset(, -1).Value <> "-" And Application.ThisCell.Offset(, -2).Value <> "-" Then
Exposure = Left(Application.ThisCell.Offset(, -1).Value, 1) * Left(Application.ThisCell.Offset(, -2).Value, 1)
End If
If Exposure = 0 Then Exposure = "-"
Application.Calculation = xlAutomatic
Application.EnableEvents = True
End Function
I put the following formula inside the merged cell "L7":=Exposure(K7;J7). Then formula is dragged down."Num1" and "Num2" are controlled by valdiation fields, drop-down menu.
My plan was to unmerge after calculating the Exposure Variant, fill the same value in the remaining rows, then re-merge the same area. So I wrote this stand alone Sub:
Sub WorkingSub(rng As Range)
'Set rng = ActiveCell.MergeArea
rng.UnMerge
For i = 2 To rng.Cells.Count
rng.Cells(i).Value = rng.Cells(1).Value 'This line triggers recursion
Next i
rng.Offset(rng.Cells.Count).Copy 'Copies format from below
rng.PasteSpecial Paste:=xlPasteFormats 'Paste that keeps the values even after merging
End Sub
Which works on its own, but not when called inside the function above. After setting the first value, the function triggers "something", debug show the the function starting over, skipping the rng.PasteSpecial Paste:=xlPasteFormats code.
So my question to you guys is how do i write my function(s) to stop "recursing" and let me unmerge during the function call?
Or am I attacking this the wrong way? What would you do?
I am stuck with merged cells for lots of reasons, this is just one part of many inside this spreadsheet.
An interesting problem. You can capture the filter event through trapping a change in a calculation and then processing the rows of the table for visibility. I've made some assumptions for the initial table range assignment which may need some alteration.
The If Not VisRange Is Nothing Then is actually redundant as the prior line will throw a fit if an empty range is assigned, but I just kept it in. In order to get around having a null range, keep the header range in the initial MergedTableRange so there will always be a row visible
Within a cell either somewhere in the same worksheet or a 'dummy' worksheet
=SUBTOTAL(103,Sheet1!A3:H10) 'Or other table range
In the worksheet module code
Private Sub Worksheet_Calculate()
Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
Dim MergedTableRange As Range: Set MergedTableRange = ws.Range("A2").CurrentRegion
Dim Cell As Range
Dim VisRange As Range: Set VisRange = MergedTableRange.SpecialCells(xlCellTypeVisible)
If Not VisRange Is Nothing Then
For Each Cell In VisRange
If Not Application.Intersect(Cell.MergeArea, VisRange).Address = Cell.MergeArea.Address Then
Cell.Rows.Hidden = True
End If
Next Cell
End If
End Sub
I came up with a different approach. Maybe there's a downside I'm missing. But my few test runs have succeeded.
I allready have a hidden sheet named "Template" where the formats for each new "#" is stored. So whenever the user wants to insert a new row, the template have the merged and the non-merged cells ready and insert is done through copy paste.
In that same sheet I made 2 merged rows in column 2, 3 merged cells in column 3 and so on:
This way I'm able to copy the correct number of merged rows to paste after filling the unmerged rows with their correct values.
I came to the conclusion that I could catch a Worksheet_change on the "Num1" and "Num2" columns instead of catching and canceling an autofilter call.
So I added:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("J:J")) Is Nothing Then
Call UnMergeMerge(Cells(Target.Row, "L").MergeArea)
End If
If Not Intersect(Target, Target.Worksheet.Range("K:K")) Is Nothing Then
Call UnMergeMerge(Cells(Target.Row, "L").MergeArea)
End If
End Sub
And the UnMergeMerge sub ended up being:
Sub UnMergeMerge(rng As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
rng.UnMerge
For i = 2 To rng.Cells.Count
rng.Cells(i).Value = rng.Cells(1).Value
Next i
With Sheets("Template")
.Range(.Cells(8, rng.Cells.Count), .Cells(8 + rng.Cells.Count, rng.Cells.Count)).Copy
End With
rng.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Still not sure it's the fastest and best approach...Do you guys still believe catching, undoing and running a different autofilter would be more effective?
I am designing a time report for my colleagues. There are cells which contain a (hidden) formula but are unprotected because I need the user to still be able to manually override the formula.
Now, if a user enters his/her own content and then deletes it again, the cell is empty, which is what I don't want, as it will only lead to confusion.
I want to write a VBA macro which recognizes if the cell contents in a previously declared range are deleted / empty and if they are deleted / empty, then a formula from another (password-protected and hidden) cell should be copied to the empty cell.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Range
Set myRange = Intersect(Range("F9:I108"), Target)
If Not myRange Is Nothing Then
'I'm guessing something with WorksheetFunction and possibly CountA,
'but I don't know how to make it work
End If
End Sub
The formulas which should be entered if the content of a cell (or of multiple cells) is deleted is always in line 117 (same worksheet). For example, if the user deletes G50, then G117's formula should be copied into G50 in the same way you usually copy formulas in Excel (so if there's a non-$-reference in G117 that points to A117, it should then point to A50 after the formula is copied to G50).
If possible, I want to work without loops--they always take so long to execute.
Thanks in advance!
Here is a super simple example that involves only 3 cells, A1, A2 and A3. You must modify this to accommodate your formula-cells.
We first create a secret worksheet (called secret). We place the formulas from A1 through A3 from the main worksheet into the secret sheet, but we store them as Strings rather than Formulas:
Then we put the following worksheet event macro in the main sheet:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("A1:A3")
If Intersect(Target, rng) Is Nothing Then Exit Sub
If Target.Count <> 1 Then Exit Sub
If Target.Value <> "" Then Exit Sub
Application.EnableEvents = False
Target.Formula = Sheets("secret").Range(Target.Address).Value
Application.EnableEvents = True
End Sub
The sub monitors changes to the three cells and if any of them are cleared, that formula will be restored from the secret worksheet.
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!
Here's another possible answer. In order to copy the formula and have it maintain the "relative addressing" of the formula, you need to copy using the R1C1 notation. So a quick sub for this could look like
Option Explicit
Sub RestoreFormula(ByRef emptyCell As Range)
Dim formulaWS As Worksheet
Dim formulaCell As Range
Set formulaWS = ThisWorkbook.Sheets("Sheet1")
Set formulaCell = formulaWS.Range("A17")
emptyCell.FormulaR1C1 = formulaCell.FormulaR1C1
End Sub
The important line here is the emptyCell.FormulaR1C1 = formulaCell.FormulaR1C1 part.
Then, over in the Worksheet_Change event it could look like this
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim checkRange As Range
Set checkRange = ActiveSheet.Range("A1:A9")
If Not Intersect(checkRange, Target) Is Nothing Then
Dim changedCell As Range
For Each changedCell In Target
If IsEmpty(changedCell) Then
RestoreFormula changedCell
End If
Next changedCell
End If
End Sub
If anyone else ever has the same problem and maybe wants to use my solution, which is a combination of PeterT's and Gary's Student's suggestions (thank you both so much):
First I created a new worksheet, in which I copied all of the formulas I wish to retain. I made sure to copy them to the exact same cell as in the original sheet.
Then I appended this code to the original worksheet:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich1 As Range
Set Bereich1 = Range("F9:I108") 'Do NOT enter multiple, non-contiguous ranges here! It crashes Excel!
If Not Intersect(Bereich1, Target) Is Nothing Then
Dim changedCell1 As Range
For Each changedCell1 In Target
If changedCell1 = "" Then
changedCell1.Formula = Sheets("Tagebuch_secret").Range(changedCell1.Address).Formula
End If
Next changedCell1
End If
Dim Bereich2 As Range
Set Bereich2 = Range("E112") 'instead duplicate the code snippet
If Not Intersect(Bereich2, Target) Is Nothing Then
Dim changedCell2 As Range
For Each changedCell2 In Target
If changedCell2 = "" Then
changedCell2.Formula = Sheets("Tagebuch_secret").Range(changedCell2.Address).Formula
End If
Next changedCell2
End If
End Sub
This works fine for every scenario in which cell contents get deleted, both if the user deletes contents of a single or multiple cells!
My next step is to make the _secret sheet very hidden, password-protect the workbook structure and then password-protect my vba project. Then only people who know the password (me) can destroy my file :)
I have Excel Workbook in which there are 4 sheet which has two cell name start date and end date, whose values should be same across all 4 sheet, I want that If I change the value in anyone of the sheets the other three sheets automatically update that values. And vice versa.
Use the Workbook_SheetChange event to update the same cells on every worksheet if any one of the cells changes.
For example, if each sheet has the named ranges start_date and end_date (where their scope is limited to that sheet only), changes made to any start_date or end_date range on any sheet will update the corresponding range on all the other sheets.
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo SafeExit
Application.EnableEvents = False
Dim ws As Worksheet
With Sh
If Not Intersect(Target, .Range("start_date")) Is Nothing Then
For Each ws In Worksheets
ws.Range("start_date").Value = Target.Value
Next ws
End If
If Not Intersect(Target, .Range("end_date")) Is Nothing Then
For Each ws In Worksheets
ws.Range("end_date").Value = Target.Value
Next ws
End If
End With
SafeExit:
Application.EnableEvents = True
End Sub
If you are referring to the cells by their address and not by a defined name, something like this could work:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo SafeExit
Application.EnableEvents = False
Dim ws As Worksheet
With Sh
' "A1" is the start date, change as needed
If Not Intersect(Target, .Range("A1")) Is Nothing Then
For Each ws In Worksheets
ws.Range("A1").Value = Target.Value
Next ws
End If
' "B1" is the end date, change as needed
If Not Intersect(Target, .Range("B1")) Is Nothing Then
For Each ws In Worksheets
ws.Range("B1").Value = Target.Value
Next ws
End If
End With
SafeExit:
Application.EnableEvents = True
End Sub
This code goes in the ThisWorkbook module in the VBA editor.
You don't need VBA for this but rather named ranges. Put your cursor in the input cell, say E5, for start_date and then click in the named range box (in the upper left corner of the worksheet grid, directly above column A). Type start_date over E5 and hit Enter. Now, cell E5 is named start_date. If you use =start_date anywhere else in the workbook, it will refer to the current contents of cell E5. If you want to edit the named ranges in any way, go to the ribbon menu FORMULAS -> Name Manager.
If you want to do this with VBA for the sole purpose of learning VBA, I would recommend taking a VBA course instead. Udemy has some good ones that often go on sale for about $10, and I'm sure that there are plenty of free resources elsewhere as well.
I have a macro so that when you highlight a row on sheet1, the macro takes all the info from this row and displays this by itself on sheet2. If you highlight a different row on sheet1, the info on sheet2 is changes to show the info from that row.
My problem is that if I change the info displayed on sheet2, it doesn't change the info on sheet1. Is there a way I could add this functionality?
I have the following code at the moment:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myList
If Target.Address <> Target.EntireRow.Address Then Exit Sub
If Target.Rows.Count > 1 Then Exit Sub
myList = [{"B1","B2","B3","B4","B5","B6","B7","B8","B9","B10","B11","B12","B13","B14","B15"}] '<- adjust to your need
With Target.EntireRow
For i = 1 To UBound(myList)
Sheets("sheet2").Range(myList(i)).Value = .Cells(i).Value
Next
End With
End Sub
Any Help would be awesome! :)
After copying your sheet1 row to sheet2 you could also record the original row # that the values came from. Then you can add an additional macro that would compare the sheet2 values with the values in sheet1 - any changes could then be migrated over.
A possible basic flow:
copy sheet1 row to sheet2 (current macro)
copy sheet1 row # to sheet2 (ie one row down)
make changes on sheet2
copy sheet2 row to sheet1 row (use row # saved on sheet2) -> this assumes that no changes will be made to sheet1.
You are currently using a Worksheet_SelectionChange event macro to recognize when a full single row has been selected. You need a Worksheet_Change event macro for Sheet2 to recognize when values in the B1:B15 range have been changed and pass the changes back to Sheet1.
Because the Worksheet_Change is triggered on a change in values, you will need to disable the Application.EnableEvents property so that it is not triggered when you write the values from Sheet1's Worksheet_SelectionChange sub.
You are going to require a couple of public variables. One to remember the position that changes should be returned to and another to locate the target cells on Sheet2. These can only be made public in a module code sheet.
Book1 - Module1 (Code)
Option Explicit
Public Const sRNG As String = "B1:B15"
Public rRNG As Range
I've made a couple of small modifications to your original Worksheet_SelectionChange and added the disabling of event handling.
Book1 - Sheet1 (Code)
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count = Columns.Count And Target.Rows.Count = 1 And _
CBool(Application.CountA(Target)) Then '<~~ one complete non-blank row
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
With Sheet2.Range(sRNG)
Set rRNG = Target.Cells(1, 1).Resize(.Columns.Count, .Rows.Count)
.Cells = Application.Transpose(rRNG.Value)
End With
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
The Worksheet .CodeName property was used to identify Sheet2 since this does not change if the worksheet is conventionally renamed.
It is a little unclear on how you were planning to identify the row to return the values to once they were changed. I've used a public range-type variable declared in Module1 to record the last location that values were transferred from Sheet1 to Sheet2. Changes on Sheet2 will return them to the last recorded location.
Book1 - Sheet2 (Code)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range(sRNG)) Is Nothing Then
Debug.Print rRNG.Address(0, 0, external:=True)
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
rRNG = Application.Transpose(Range(sRNG).Value)
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
Note that the 'remembered' location is in memory only. Closing and reopening the workbook effectively 'zeroes' it. Do not make changes on Sheet2 unless you have freshly loaded values from Sheet1.