I would like a pop up form named 'Question' to show up when a value in cell A9 in worksheet called 'Calculator' matches one of the values in Column O in Worksheet 'Data'.Values. In cell A9 are results of formula.
This code works but when I have other Excel workbooks open, it gives me 'Subscript out of range error'. I would like it to apply to this one particular workbook and not affect the other workbooks I have open.
Private Sub Worksheet_Calculate()
If IsError(Application.Match(Range("A9").Value, Sheets("Data").Columns("O"), 0)) Then Exit Sub
If Application.Match(Range("A9").Value, Sheets("Data").Columns("O"), 0) Then
Question.Show
End If
End Sub
You could make the code reference only the workbook that the code is stored in:
Private Sub Worksheet_Calculate()
With ThisWorkbook
If IsError(Application.Match(.ActiveSheet.Range("A9").Value, .Sheets("Data").Columns("O"), 0)) Then Exit Sub
If Application.Match(.ActiveSheet.Range("A9").Value, .Sheets("Data").Columns("O"), 0) Then
Question.Show
End If
End With
End Sub
...It would be good to replace ActiveSheet with a specific sheet reference.
Related
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'm trying to run a macro in excel at a specific time if check box is checked.
It is working as it should, only problem is that it works only when
workbook is set to automatic calculations and I need workbook to be set to manual calculations.
Here is a VBA code I'm using in that file:
sheet1:
Private Sub Worksheet_Calculate()
Dim time_dt As Date
time_dt = Cells(1, 7)
If Range("C1").Value = "YES" Then
Application.OnTime TimeValue(time_dt), "FillFirstColumn"
End If
End Sub
and here is a Module 1 code:
Sub FillFirstColumn()
Range("A1:A20").Value = "YES"
End Sub
When I click on check box, cell D1 is changing from FALSE to TRUE. In a cell C1 I have this formula =IF(D1=TRUE,"YES","NO"). And C1 is not recalculating unless a workbook is set to automatic.
Based on advice from a comment below I've added this VBA code to sheet1:
Private Sub CheckBox1_Click()
ThisWorkbook.Worksheets("Sheet1").Cells(1, "C").Calculate
End Sub
but formula in C1 is still not recalculating.
You can Calculate all open workbooks, one workbook with many worksheets, one worksheet, a range of cells in a worksheet or a single cell.
thisworkbook.worksheets("sheet1").cells(2, "B").calculate
The above will recalculate a single cell (Sheet1!B2) in the workbook that the sub procedure was running in.
I have a Function that is attempting to change the current active sheet ("Sheet1") to (Sheet2) and then assign a value to a cell in Sheet2.
However the ActiveSheet.name doesn't change and the assignment fails. see the code snippet. The function is called from sheet1.
Dim oldwksheet as String
oldwksheet = ActiveSheet.Name 'value is Sheet1
Sheets("Sheet2").Activate
Sheets("Sheet2").Select
oldwksheet = ActiveSheet.Name 'value still is Sheet1"
Sheets("Sheet2").Range("F2") = Now() 'this fails.
end function
Why? What am I doing wrong.
You need a sub and not a function.
A function can only return a value to the cell in which it resides. It can't select or activate worksheets or deposit values in arbitrary cells.
I couldn't say why, but you could use a Function
assuming your function's named after "MyFunction" then place in relevant worksheet code pane the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then If Left(Target.Formula, 12) = "=MyFunction(" Then Sheets("Sheet2").Range("F2") = Now()
End Sub
this way, whenever you type =MyFunction() in any cell of the relevant worksheet, the current date and time is being placed in cell F2 of Sheet2
I have a single workbook with multiple sheets. Sheet 1 uses cell A1 as a search box to find a specific sheet in the book. The sheets after Sheet 1 are named like this, SO123456 with different numbers following the SO. I have the following code on sheet 1 to open the corresponding sheet from the value typed into A1 of Sheet 1:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("A1"), Target) Is Nothing Then Exit Sub
Sheets(Target.Value).Activate
End Sub
When the corresponding sheet is opened, I want to open it to the next empty cell in column A. I have some code on the SOxxxxxx sheets that populates time in Column C when my data is entered in Column A. Here is that code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Columns("A:A")) Is Nothing Then
Target.Offset(0, 2).Value = Now
End If
End Sub
I'm not sure how to make sure the first empty cell in Column A is selected or where the code goes; sheet being opened or where the call is to open the sheet. I tried entering the following code below the Worksheet_Change block with no luck:
Range("A" & Rows.Count).End(xlup).Offset(1).Row
Cells(Rows.Count,1).End(xlup).Offset(1).Row
UsedRange.Rows.Count
I know next to nothing about VBA if you haven't already noticed.
Try this
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "A$1” Then Exit Sub
With WorkSheets(Target.Value)
.Activate
.Cells(.Rows.Count,1).End(xlup).Offset(1).Select
End With
End Sub
This should get you to the first empty cell in Column A
rowEmpty = Range("A" & 10000).End(xlup).Row +1
You can replace the number 10000 with a sufficiently large number that ensures there will be no data there. There are alternatives to that, but I think this one is easier to begin with.
With this code, typing a sheet name in cell A1 from sheet1 will activate the sheet you type, and the active cell will be the first one in blank in column A.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("A1"), Target) Is Nothing Then Exit Sub
Sheets(Target.Value).Activate
ActiveSheet.Cells(Sheets(Target.Value).Range("A1").End(xlDown).Row + 1, 1).Select
End Sub