Run macro at specific time when check box is checked(manual calculation) - excel

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.

Related

Run VBA macro when cell is updated - not by user or another macro

I have a spreadsheet, which uses an external add-on that updates values in a cell. Notice, the cell is not changed, only the value is updated.
I would like to run a macro every time the cell is updated.
To simulate the problem:
Create an empty excel sheet
In cell A1 add the formula '=rand()'
In VBA add a macro for sheet1, here a simplified version:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Cells(1, 3).Value = "The function updated"
End If
End Sub
However, when I thereafter press F9 (to update the random numbers), the sheet does not recognize this as a sheet change, hence the macro is not run. How can I make the macro run when e.g. a random number in the sheet i updated?
The way I would tackle this is to set a global variable pointing to the cell in question (as double) as follows:
Global clvalue As Double
Then have a workbook open event which sets the variable to the cell value as follows:
Private Sub Workbook_Open()
clvalue = Round(Sheet1.Range("C5").Value, 2)
End Sub
The a worksheet Calculate event to do the comparison and resetting of the global variable to the new cell value as follows:
Private Sub Worksheet_Calculate()
If Sheet1.Range("C5").Value <> clvalue Then
Debug.Print clvalue
clvalue = Sheet1.Range("C5").Value
Debug.Print "New Global Variable is now " & clvalue
End If
End Sub

macro only runs manually

My knowledge with VBA is fairly basic so this may seem like a silly question.
I have written a code so that cell A1 in sheet1 will read "XX" if cell B1 in sheet2 has a value in it. The code works but only if I select it and run it manually from VBA. if cell B1 in sheet2 has a value in it, cell A1 in sheet1 is not updating automatically. Here is the code
Sub IsNumeric()
If Sheets ("Sheet2").Range("B2) > 0 Then
Sheets("Sheet1").Range("A1").Value = "XX"
End If
End Sub
Cell B2 in sheet2 is a formula which will only generate a number if another cell is selected. i am not sure if this is relevant but as i mentioned the code is working just fine, just not automatically.
Thanks!
You need to change your code a touch. Have a proper UDF defined and called from Sheet1 A1, with a reference passed to Sheet2 A1, for example
The function
Function IsNumeric2(rngCheck As Excel.Range)
If rngCheck.Value > 0 Then
IsNumeric2 = "XX"
Else
IsNumeric2 = ""
End If
End Function
The call, in cell A1, =IsNumeric2(Sheet2!A1)
If you want macro's to work automatically, based on an event in the workbook, you can add a workbook event macro in ThisWorkbook. In this case you can use the Workbook_SheetChange event for instance, which runs everytime you make a change on a sheet: https://learn.microsoft.com/en-us/office/vba/api/excel.workbook.sheetchange
Private Sub Workbook_SheetChange(ByVal Sh As Object,ByVal Source As Range)
Application.EnableEvents = False 'Switch off events because otherwise it gets triggered again for the changes made in this macro
'First make sure that it only triggers when you change B2 of sheet 2
If Source.Address = "$B$2" and Source.Parent.Name = "Sheet2" then
If Source.Value > 0 Then
ThisWorkbook.sheets("Sheet1").Range("A1").Value = "XX"
End If
end if
Application.EnableEvents = True 'Turn the events back on again.
End Sub

Fill a cell with VBA if contents get deleted by User

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 :)

Pop up form depending on cell value

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.

Mirroring column in one excel sheet to other multiple excel sheets with automatic updating

I have an excel workbook that contains multiple sheets within it. For the sake of this question, the sheets are named Sheet1, Sheet2, Sheet3, and so on. I would like to have Column A from sheet1 be replicated throughout the rest of the sheets and as new cells are added to column A in sheet1, they would automatically be entered into the other sheets within the workbook. I would prefer not to have a set "ending range; ie: A100000" for this. For example, if I enter First in cell A1 of Sheet1, the word "First" should now also appear in cell A1 of Sheet2. I have used the following code, and it does not seem to work. Any help would be greatly appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Call UpdateFromSheet1
End Sub
Sub UpdateFromSheet1(ByVal Sh As Object, ByVal Target As Range)
If Sh.CodeName = "Sheet1" Then
If Not Intersect(Target(1, 1), Range("A1:A1000")) Is Nothing Then
Sh.Range("A1:A1000").Copy Sheet2.Range("A1")
End If
End If
End Sub
UPDATE
For a clean looking Non-VBA solution, you can use the formula references that others have mentioned, but enter it like this.
In Sheet2 cell A1 = If(Sheet1!A1="","",Sheet1!A1) That way you can fill down on the whole of column A and not have "0" pop-up if Sheet1 has a rows without data.
I think you have the general idea, but I suspect you may not have your code in the right place.
For the VBA solution:
First, you don't need to call the sub from Worksheet_Change event (unless of course you want to use this sub for other reasons and pass variables to it. Second, if you place this code in the worksheet object in the VBE of the "Sheet1" it will do as you wish:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("A")) Is Nothing Then
Dim wks As Worksheet
For Each wks In Sheets(Array("Sheet2", "Sheet3"))
Target.EntireColumn.Copy wks.Columns(1)
Next
End If
End Sub
This is a very basic use for excel. You can set cells equal to each other. You in no way would need a VBA macro for this.
If you put this in cell "A1" on Sheet2 and Sheet3:
=Sheet1!A1
Then when you type something into A1, it will be "mirrored" on sheets 2 and 3. You can autofill this down to all the cells in column A on sheets 2 and 3.
Are you familiar with the term autofill?
If you don't understand anything I just said and you want to just run a macro then run this and start typing away:
Sub MacroBasicQuestion()
Dim wbk As Workbook
Set wbk = ThisWorkbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Set ws1 = wbk.Sheets(1)
Set ws2 = wbk.Sheets(2)
Set ws3 = wbk.Sheets(3)
Dim cell As Range
Set cell = ws2.Range("A1:A1")
ws2.Select
cell.FormulaR1C1 = "=Sheet1!RC"
cell.Select
Selection.AutoFill Destination:=Range("A:A"), Type:=xlFillDefault
Set cell = ws3.Range("A1:A1")
ws3.Select
cell.FormulaR1C1 = "=Sheet1!RC"
cell.Select
Selection.AutoFill Destination:=Range("A:A"), Type:=xlFillDefault
End Sub
Good Luck.

Resources