As per subject, what I need is to run macro based on other cells.
Here is the case :
cells G3 until the end of row contains data used formula =IF(B3="";"";(SUMIF('Incoming Goods'!$F$3:$F$1048576;'Current Stock'!B3;'Incoming Goods'!$M$3:$M$1048576)-(SUMIF('Outgoing Goods'!$D$4:$D$1048576;'Current Stock'!B3;'Outgoing Goods'!$J$4:$J$1048576))))--> i need to convert this formula to VBA
cells H3 should contain : If G3.value = 0 then "Out of Stock", else " "
And this sheet must be calculate every time data in G3 change automatically or any additional data on this sheet.
Already tried this code :
Private Sub Worksheet_Calculate()
Dim Current As Worksheet
Dim Rng1 As Range
Dim Target As Range
Set Current = Worksheets("Current Stock")
Set Rng1 = Current.Range("G:G")
Set Target = Range("H:H")
For Each Rng1 In Target
If Rng1.Value2 = "0" Then
Target.Value2 = "Out Of Stock"
Else
Exit Sub
End If
Next
End Sub
However, above code is Not working. Already try using Private Sub Selection Change() and Private Sub Selection Change() but still not working.
Any suggestion?
Thanks in advance
the answer to the first part is below:
ActiveCell.FormulaR1C1 = _
"=IF(R[2]C[1]="""","""",(SUMIF('Incoming Goods'!R3C6:R1048576C6,'Current Stock'!R[2]C[1],'Incoming Goods'!R3C13:R1048576C13)-(SUMIF('Outgoing Goods'!R4C4:R1048576C4,'Current Stock'!R[2]C[1],'Outgoing Goods'!R4C10:R1048576C10))))"
handy tip: to convert any excel formula to code, hit the record macro button, then click on the cell, press F2 key, then press enter, and stop recording macro. The code will now be in its own module in the vba editor.
This should do what you want.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("A1"), Target) Is Nothing Then
If IsNumeric(Target.Value) And Target.Value > 200 Then
Call YourMacroName
End If
End If
End Sub
Related
I may or may not have an easy one here... For some reason I can't properly think of the solution.
Spreadsheet has numbers 1 to 14 in column A. 14 ends on row 15 as there is a header in cell A1. What I'm trying to do is double click one of these numbers and transfer that number to a specific cell on the same sheet (named "Sheet1"). I was able to put the code together to make it work for transferring a chosen number to a specific cell. Code below works well. However, I don't want to add a bunch of areas to double click for different cells. For example: The destination cell for the chosen data is E6, H6, and G6. I'd like to place the cursor starting in E6, double click a number in range A2 to A15, and have that number that I choose between A2 and A15 to appear in E6 since that is where the cursor was when I double clicked a cell in A2 to A15. Then I would move the cursor by click H6 and then going back to same selection between A2 to A15, placing whatever number I choose in that range in H6 since that is where the cursor currently exists.
Hopefully this makes sense and is even possible.
example screenshot
Working code that allows the double click to put data in a certain cell
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A2:A15")) Is Nothing Then
Cancel = True
Target.Copy Destination:=Cells(6, "E")
End If
End Sub
I've added the solution I would try, with comments in the code. The reason for two sheet variables, is because the first click in the double-click registers as a SelectionChange event. So to get the correct cell location, you need it from two selections back, instead of just one.
Public selectedCell As String 'Sheet Variable
Public lastCell As String
' This updates the Sheet variable with the most recent selection
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
selectedCell = lastCell
lastCell = Target.Address
End Sub
' Added a check for having a previously selected cell
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A2:A15")) Is Nothing Then
If selectedCell = vbNullString Then
Cancel = True
MsgBox "Please select a destination cell for the data."
selectedCell = vbNullString
lastCell = vbNullString 'Prevents overwriting same cell by accident
Else
Cancel = True
Target.Copy Destination:=Range(selectedCell)
selectedCell = vbNullString
lastCell = vbNullString 'Prevents overwriting same cell by accident
End If
End If
End Sub
Here is a tiny tool that you may be able to adapt to your needs. If you double-click on an empty cell, it becomes the FinalDestination. If you then double-click on another cell that is not empty, its contents will be copied to FinalDestination:
In the worksheet code area:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Application.EnableEvents = False
If Target.Value = "" Then
Set FinalDestination = Target
Else
Target.Copy FinalDestination
End If
Application.EnableEvents = True
End Sub
In a standard module:
Public FinalDestination As Range
NOTE:
In this simple demo code there are no restrictions on source/destination.
I would like to do a macro. My testing cells are on another sheet. Sheet - (data) Macro check a range ("D2:D10") if the cells contain value 12 if yes show me a message box "Go to add to system" and this cell where macro found a value will be set to 0.
I have this code but it doesn't work for me I don't known why. Can you help me?
Private Sub check(ByVal Target As Range)
For Each c In Worksheet("data").Range("D2:D10")
If Range("D2:D10") = 12 Then
MsgBox "Go to add to system"
Range ("D2:D10").value = 0
End If
Next c
End Sub
The code below will correct your code (it will run without errors):
Option Explicit
Private Sub check(ByVal Target As Range)
Dim c As Range
For Each c In Worksheets("data").Range("D2:D10")
If c.Value = 12 Then
MsgBox "Go to add to system"
c.Value = 0
End If
Next c
End Sub
However, you could go with a slightly different approach - by accomplishing what you are trying to achieve in the Worksheet_Change event (of "data" sheet).
Code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
' Optional : use if criteria below to check the range only
' if one of the cells inside range("D2:D10") has changed
If Not Intersect(Range("D2:D10"), Target) Is Nothing Then
' if you decide to use the "If"above, then you don't need the "For" loop below
For Each c In Range("D2:D10")
If c.Value = 12 Then
MsgBox "Go to add to system"
c.Value = 0
End If
Next c
End If
End Sub
I have data in column "AK" and a button in Column "AL"; there are several hundred rows and there is only one macro for all buttons as it uses relative references based on the row it is in.
I want the button to only be visible when there is data in the adjacent cell. The following pseudo-code explains what I am trying to achieve:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 37 Then
If Target.Value = 0 Then
Shapes(Target.offset(0, 1)).Visible = False
Else
Shapes(Target.offset(0, 1)).Visible = True
End If
End If
End Sub
The reason for doing this is that the value in AK is calculated based on other values and only displays once all mandatory fields have been completed. The button should only be available for an automation task once all details are complete. What real code would make this work without having to call each button out individually?
I'm not sure if you can directly reference a shape by its location on the sheet.
This code will look at each shape until it finds the one to the right of the cell you've just changed, it will then change the visibility based on the contents of the cell.
(Target.Value <> "") returns TRUE/FALSE.
This will only work if your buttons are placed in the correct cell (slightly too high and it will return the cell above).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim shp As Shape
For Each shp In ThisWorkbook.Worksheets("Sheet1").Shapes
If shp.TopLeftCell.Address = Target.Offset(, 1).Address Then
shp.Visible = (Target.Value <> "")
Exit For 'Exit the loop - the correct button has been found.
End If
Next shp
End Sub
Edit:
I've updated the code so it checks that only a single cell has been changed and then looks at each dependent cell of the cell that was changed.
This will probably muck up if the dependent cell is on another sheet though.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rUpdated As Range
Dim shp As Shape
Dim rCell As Range
If Target.Cells.Count = 1 Then
'Hopefully someone will have better code than On Error....
On Error Resume Next
Set rUpdated = Range(Target.Dependents.Address)
On Error GoTo 0
If Not rUpdated Is Nothing Then
'Look at each dependent cell in rUpdated.
For Each rCell In rUpdated
'Look at each shape in the sheet and cross-reference with rCell.
For Each shp In Target.Parent.Shapes
If shp.TopLeftCell.Address = rCell.Offset(, 1).Address Then
shp.Visible = (Target.Value = 0)
Exit For 'Exit the loop - the correct button has been found.
End If
Next shp
Next rCell
End If
End If
End Sub
NB: I got the idea for checking the dependent cell from here: How can I run a VBA code each time a cell get is value changed by a formula?
I am working on a file which in one sheet lets call it summary, I have formula that calculate the values which Ienter manually in other sheets, so I want to have an vba code to notify me by pop up message that the calculation result in summary sheet is <=0 when doing data entry in other sheets.
I have found below code which works fine with only one cell but if I want to extend it to other cells in the same row results in error. Suppose I want to extend it to B9:CZ9.
Private Sub Worksheet_Calculate()
If Me.Range("B9").Value <= 0 Then _
MsgBox "Leave is finished!"
End Sub
Possible background:
Private Sub Worksheet_Calculate()
With Me.Range("B9:CZ9")
If Application.CountIf(.Cells, "<=0") = .Cells.Count Then _
MsgBox "Leave is finished!"
End With
End Sub
Private Sub Worksheet_Calculate()
Dim RNG As Range
Set RNG = Selection
For Each c In RNG
If c.Value <= 0 Then
MsgBox "Leave is finished!"
End If
Next c
End Sub
If I understood you correctly, maybe this code helps you (you have to put this code to the source of the correct worksheet you want to work this code on):
Private Sub Worksheet_Calculate()
Dim leave As Boolean: leave = False
For Each c In Me.Range("B9:CZ9").Cells
If c.Value <= 0 Then: leave = True
Next
If leave Then: MsgBox "Leave is finished!"
End Sub
This code works when something is calculated in a cell, for example when you type =0 into any of them, and don't give you lots of messageboxes.
If you want this to work when anything changes, use Private Sub Worksheet_Change(ByVal Target As Range)
Remember that extension xlsx cannot contain VBA codes. Therefore after implementing the code to the worksheet you want this code works on, you have to save it as macro-enabled workbook.
This should be simple. When the value of a cell changes I want to trigger some VBA code. The cell (D3) is a calculation from two other cells =B3*C3. I have attempted 2 approaches:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 And Target.Row = 3 Then
MsgBox "There was a change in cell D3"
End If
End Sub
Since the cell is a calculation this is not triggered when the value changes, because the calculation remains the same. I also tried:
Private Sub Worksheet_Calculate()
MsgBox "There was a calculation"
End Sub
But I have multiple calculations on the sheet and it triggers multiple times. Is there a way I can identify which calculation changed on the calculation event? Or is there another way I can track when D3 changes?
Could you try something like this? Change the formula to =D3AlertOnChange(B3*C3).
Private D3OldVal As Variant
Public Function D3AlertOnChange(val)
If val <> D3OldVal Then MsgBox "Value changed!"
D3OldVal = val
D3AlertOnChange = val
End Function
Or try
Private Sub Worksheet_Change(ByVal Target As Range)
Dim numdependences As Integer
On Error Resume Next
HasDependents = Target.Dependents.Count
If Err = 0 Then
If InStr(Target.Dependents.Address, "$D$3") <> 0 Then
MsgBox "change"
End If
End If
On Error GoTo 0
End Sub
You need the error control in case you change a cell that has not dependents.
try this:
Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("B1")) Is Nothing Then
Call macro
End If
End Sub
looks for a change in value of cell B1, then executes "macro"
If you are only looking at if the Worksheet_Change then it will count a change for anything entered even if it is the same as the previous value. To overcome this I use a Public variable to capture the starting value and compare it.
This is my code to do this. It also allows you omit parts of the worksheet or you can use it to evaluate every cell in the worksheet.
Place this code in the Worksheet.
Public TargetVal As String 'This is the value of a cell when it is selected
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge > 1 Then 'If more then one cell is selected do not save TargetVal. CountLarge is used to protect from overflow if all cells are selected.
GoTo EXITNOW
Else
TargetVal = Target 'This sets the value of the TargetVal variable when a cell is selected
End If
EXITNOW:
End Sub
Sub Worksheet_Change(ByVal Target As Range)
'When a cell is modified this will evaluate if the value in the cell value has changed.
'For example if a cell is entered and enter is pressed the value is still evaluated
'We don't want to count it as a change if the value hasn't actually changed
Dim ColumnNumber As Integer
Dim RowNumber As Integer
Dim ColumnLetter As String
'---------------------
'GET CURRENT CELL INFO
'---------------------
ColumnNumber = Target.Column
RowNumber = Target.Row
ColumnLetter = Split(Target.Address, "$")(1)
'---------------------
'DEFINE NO ACTION PARAMETERS
' IF CELL CHANGED IS IN NO ACTION RANGE, EXIT CODE NOW FOR PERFORMANCE IMPROVEMENT OR TO NOT TAKE ACTION
'---------------------
If ColumnNumber <> 4 Then 'This would exempt anything not in Column 4
GoTo EXITNOW
ElseIf RowNumber <> 3 Then 'This would exempt anything not in Row 3
GoTo EXITNOW
'Add Attional ElseIf statements as needed
'ElseIf ColumnNumber > 25 Then
'GoTo EXITNOW
End If
'---------------------
'EVALUATE IF CELL VALUE HAS CHANGED
'---------------------
Debug.Print "---------------------------------------------------------"
Debug.Print "Cell: " & ColumnLetter & RowNumber & " Starting Value: " & TargetVal & " | New Value: " & Target
If Target = TargetVal Then
Debug.Print " No Change"
'CALL MACRO, FUNCTION, or ADD CODE HERE TO DO SOMETHING IF NOT CHANGED
Else
Debug.Print " Cell Value has Changed"
'CALL MACRO, FUNCTION, or ADD CODE HERE TO DO SOMETHING IF CHANGED
End If
Debug.Print "---------------------------------------------------------"
EXITNOW:
End Sub