I am trying to create a confirmation so that when the cell is blank a prompt launches. If the user clicks confirm, the cell remains blank, else the cell returns to the original value. I have the following but it is not working, I hope that someone can solve this:
Private Sub MYtest()
Dim vatcell As Range
Set vatcell = Worksheets("Invoice").Range("D11:D11")
If vatcell = "" Then
response = MsgBox("Are you sure you want to change the VAT ammount?" & Chr(10) & Chr(10) _
& "Value = " & vatcell & Chr(10) & Chr(10) _
& "Do you really want to change it?", vbYesNo + vbQuestion, "Value Already Entered")
If response = vbYes Then
vatcell = ""
Else
vatcell = vatcell
End If
End If
End Sub
Thanks in advance.
The script from Daryll, which is not working:
There are two missing pieces to your solution. First, you need to store the value of the cell before it changed. Second, you need to connect to an event that tells you when the cell contents have changed.
' This is where you store the value before it was changed
Private last_vat As Variant
' this is where you capture the value when the worksheet is first loaded
Private Sub Worksheet_Activate()
Dim vatcell As Range
Set vatcell = Range("D11")
last_vat = vatcell.Value
End Sub
' This is where you respond to a change
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vatcell As Range
Set vatcell = Range("D11")
' Make sure the cell that changed is the one you are interested in
If Target = vatcell Then
' If it changed from something to nothing
If vatcell.Value = "" And last_vat <> "" Then
response = MsgBox("Are you sure you want to clear the VAT ammount?" & Chr(10) & Chr(10) _
& "Previous Value = " & last_vat & Chr(10) & Chr(10) _
& "Do you really want to change it?", vbYesNo + vbQuestion, "Value Already Entered")
If response = vbYes Then
' Allow the change (by doing nothing)
Else
' Reject the change
vatcell = last_vat
End If
End If
' Save changes from non-blank to different non-blank value
last_vat = vatcell.Value
End If
End Sub
I believe you want to have this be an event procedure. The below checks to see if cell D11 have been changed every time the worksheet "Invoice" is changed. Please note that this must be stored on the worksheet "Invoice" in the VBE.
Private Sub Worksheet_Change(ByVal Target as Range)
Dim vatcell As Range
Set vatcell = Worksheets("Invoice").Range("D11:D11")
If Not Intersect(Target,vatcell) is Nothing Then
response = MsgBox("Are you sure you want to change the VAT ammount?" & Chr(10) & Chr(10) _
& "Value = " & vatcell & Chr(10) & Chr(10) _
& "Do you really want to change it?", vbYesNo + vbQuestion, "Value Already Entered")
End If
If response = vbYes Then
vatcell = ""
Else
vatcell = vatcell
End If
End Sub
Related
I wrote code to reformat a workbook by separating and combining information on separate sheets and then save every sheet separately as a CSV.
The beginning of my code:
Sub All()
Dim Bottom As Long
Dim Header As Long
> 'A. CHECK DATE
If ThisWorkbook.Sheets("ACH PULL").Range("C1") <> Date Then
MsgBox "ERROR" & Chr(10) & "Date on file is different than today's date" & Chr(13) & "Ask client for corrected file"
Exit Sub
Else
> '1. OUTGOING CHECKS
Sheets("OUTGOING CHECKS").Select
Bottom = WorksheetFunction.Match((Cells(Rows.Count, 1).End(xlUp)), Range("A:A"), 0)
Header = WorksheetFunction.Match("Account*", Range("A:A"), 0)
If Bottom <> Header Then
MsgBox "ERROR" & Chr(10) & "The batch contains outgoing checks" & Chr(13) & "Ask client for corrected file"
Exit Sub
Bottom and Header are used to find the header of the range and the last row respectively. I use this so many times in my code on separate sheets.
The code works when I run it from the file that I need to modify. But I need to assign it to a button to another spreadsheet to open the to-be-modified file through VBA and then apply the code. So I added this:
Sub All()
Dim FileToOpen As Variant
Dim NewBatch As Workbook
Dim Bottom As Integer
Dim Header As Integer
FileToOpen = Application.GetOpenFilename(Title:="Find batch file")
If FileToOpen <> False Then
Set NewBatch = Application.Workbooks.Open(FileToOpen)
End If
'A. CHECK DATE
If Sheets("ACH PULL").Range("C1") <> Date Then
MsgBox "ERROR" & Chr(10) & "Date on file is different than today's date" & Chr(13) & "Ask client for corrected file"
Exit Sub
Else
'1. OUTGOING CHECKS
Sheets("OUTGOING CHECKS").Select
Bottom = WorksheetFunction.Match((Cells(Rows.Count, 1).End(xlUp)), Range("A:A"), 0)
Header = WorksheetFunction.Match("Account*", Range("A:A"), 0)
End If
If Bottom <> Header Then
MsgBox "ERROR" & Chr(10) & "The batch contains outgoing checks" & Chr(13) & "Ask client for corrected file"
Exit Sub
' .. The rest of the code
At the line:
Bottom = WorksheetFunction.Match((Cells(Rows.Count, 1).End(xlUp)), Range("A:A"), 0)
I either get 1004 or 400 error.
I have the two pieces (opening a workbook, and reformatting) working separately, but I can't combine them.
I Dim'd the two integers that I need to use before using them.
I tried making multiple changes including NewBatch.Activate.
It didn't made a difference as the opened workbook is already activated. I tried to set the values for Bottom and Header.
Something like this maybe:
Sub All()
Dim FileToOpen As Variant
Dim NewBatch As Workbook
Dim Bottom As Long, Header As Variant 'not Long
FileToOpen = Application.GetOpenFilename(Title:="Find batch file")
If FileToOpen = False Then Exit Sub 'user cancelled open
Set NewBatch = Application.Workbooks.Open(FileToOpen)
'A. CHECK DATE
If NewBatch.Sheets("ACH PULL").Range("C1").Value <> Date Then
ProblemMsg "Date on file is different than today's date." & _
vbLf & "Ask client for corrected file"
Exit Sub
End If
'1. OUTGOING CHECKS
With NewBatch.Sheets("OUTGOING CHECKS")
Bottom = .Cells(.Rows.Count, 1).End(xlUp).Row 'last entry in Col A
Header = Application.Match("Account*", .Range("A:A"), 0) 'not WorksheetFunction.Match
If IsError(Header) Then 'make sure we located "Account*"
ProblemMsg "'Account*' not found in ColA on sheet '" & .Name & "'"
Else
If Bottom <> Header Then
ProblemMsg "The batch contains outgoing checks." & vbLf & _
"Ask client for corrected file."
Exit Sub
End If
End If
End With
'...
'...
End Sub
'Utility sub for displaying error messages
Sub ProblemMsg(msg As String)
MsgBox "ERROR" & vbLf & msg, vbExclamation, "Please review"
End Sub
I have found more reliable performance by defining worksheets and referencing rather than relying on selection or active sheet. Try defining the worksheet this line is being performed on and referencing before the range() and cells() references and see if that helps.
Dim ws as Worksheet
Set ws = Sheets("OUTGOING CHECKS")
Bottom = WorksheetFunction.Match((ws.Cells(Rows.Count, 1).End(xlUp)), ws.Range("A:A"), 0)
I have an excel table with a column named "Completed?" that users select Yes or No from the drop down. If they Select Yes a Message Box using vbOKCancel pops up. If they confirm Yes that part is working so far, but if anything else happens (they hit Cancel, or X out, etc) I want this field to be changed to "No" - this is what I'm struggling with.
It seems like it should be simple - any ideas?
If Target.Column = 3 And Target.Value = "Yes" Then
Dim answer As Integer
answer = MsgBox("Are you sure you want to mark this as Completed? This will move the record to the Completed Tab and cannot be undone.", vbOKCancel + vbCritical, "CRITICAL WARNING")
If answer = vbOK Then MsgBox ("OK")
'need help with this next row
Else: Target.Value = "No"
End If
End Sub
Fundimentaily, you issue is missuse of the If Then Else End IF structure. (you are mixing Multi Line and Single Line syntax)
See here for more details
There are some other issues too, see inline comments
Private Sub Worksheet_Change(ByVal Target As Range)
Dim answer As VbMsgBoxResult ' use correct data type
Dim rng As Range, cl As Range
On Error GoTo EH ' ensure events get turned back on
Application.EnableEvents = False ' prevent event cascade
Set rng = Application.Intersect(Target, Me.Columns(3)) ' get all cells in column 3 that changed
For Each cl In rng ' process each changed cell
If LCase(cl.Value) = "yes" Or LCase(cl.Value) = "y" Then ' case insensitive
answer = MsgBox("Are you sure you want to mark row " & cl.Row & " as Completed?" & vbNewLine & vbNewLine & "This will move the record to the Completed Tab and cannot be undone.", vbOKCancel + vbCritical, "CRITICAL WARNING")
If answer = vbOK Then
cl.Value = "Yes" ' Standardise case
' MsgBox "OK" ' this is a bit annoying
Else
cl.Value = "No"
End If
End If
Next
EH:
Application.EnableEvents = True
End Sub
try this:
If Target.Column = 3 And Target.Value = "Yes" Then
Dim answer As Integer
answer = MsgBox("Are you sure you want to mark this as Completed? " & _
"This will move the record to the Completed Tab and cannot be undone.", vbOKCancel + vbCritical, "CRITICAL WARNING")
If answer = vbOK Then
MsgBox ("OK")
Else
Target.Value = "No"
End If
End If
What are options to monitor changes in an Excel table?
Possible solution I can think of is to have a clone copy of the table, say in a hidden worksheet and a formula which compares both sheets.
Is there any other way?
Well, there are multiple ways.
On way would be to subscribe to Worksheet_Change event with such method:
Private Sub Worksheet_Change(ByVal Target As Range)
'some code, which will compare values and store info in a file
End Sub
I suggested also way of logging such event: take user name and what has changed and write this info to a file.
Also, you'd need to do some extra coding to see if this is the change you are interested in, but this is left for you to discover, as it is to broad to describe all the options here :)
I've come up with a code (as an event based code - Worksheet_Change) like this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range
Set rg = Cells
Dim lastrow As Long
Dim username As String
If Intersect(Target, rg) Is Nothing Then Exit Sub
On Error GoTo ExitHere
Application.EnableEvents = False
With SomeOtherSheet
lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row
.Range("H" & lastrow + 1) = Now
.Range("I" & lastrow + 1) = Target.Address
.Range("J" & lastrow + 1) = Environ("Username")
.Range("K" & lastrow + 1) = Application.username
End With
ExitHere:
Application.EnableEvents = True
End Sub
It records any change made by a user in the given Sheet (the one where the code is written). It will show me in another Sheet who, when and where the change was done. The only problem I have with this matter is that the user has to enable macros, otherwise it doesn't work... I don't know how to reasonably solve this issue...
I totally agree with #Michał Turczyn. For security reasons is better to keep records about the changes. You could use:
Option Explicit
Dim OldValue As String
Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "The old value was " & OldValue & "." & vbNewLine & _
"The new value is " & Target.Value & "." & vbNewLine & _
"Date of change " & Now & "." & vbNewLine & _
"Change by " & Environ$("computername") & "."
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
OldValue = Target.Value
End Sub
I have a worksheet (sheet1) which contains a cell A1 with formula ='sheet2'!D10. I would like to run a macro each time cell A1 in sheet1 changes (as a result of a change in D10 in sheet2). sheet2 is streaming financial data.
Because it is a change in value, Worksheet_Change does not trigger an event. I also can't seem to find a solution with Worksheet_Calculate.
In my research, the closest solution I could find was offered here, but I have not been able to successfully implement it.
You are going to have to use Worksheet_Calculate. It's unclear on whether the 'streaming' will trigger a Worksheet_Calculate in Sheet2 but the linked cell in Sheet1 will definitely trigger a Worksheet_Calculate in that worksheet's private code sheet providing you have calculation set to automatic.
You need a variable that will hold previous values of Sheet1!A1 that can be compared to the current value of Sheet1!A1. Some prefer to use a public var declared in a public module's declaration area; I prefer to use a static var within Sheet1's Worksheet_Calculate itself.
From Microsoft Docs,
Normally, a local variable in a procedure ceases to exist as soon as the procedure stops. A static variable continues to exist and retains its most recent value. The next time your code calls the procedure, the variable is not reinitialized, and it still holds the latest value that you assigned to it. A static variable continues to exist for the lifetime of the class or module that it is defined in.
The first issue is seeding the static variable for its first use. A variant-type variable that has never been given a value report True when tested with IsEmpty so when the workbook is first opened, the first calculation cycle will simply record the value of Sheet1!A1 into the static var. Any future calculation cycle will compare the value in Sheet1!A1 to the value held in the static var and if they are different, the external sub procedure ('... run a macro ...' according to your question's narrative) will be run and the new value of Sheet1!A1 will be stored in the static var. In this way, any change in the value returned by the formula in Sheet1!A1 will force a calculation cycle, hence the worksheet's Worksheet_Calculate event sub procedure which will in turn run your external sub procedure.
In Sheet1's private code sheet
Option Explicit
Private Sub Worksheet_Calculate()
Static s2d10 As Variant
If IsEmpty(s2d10) Then
'load static var with expected value
s2d10 = Cells(1, "A").Value2
ElseIf s2d10 <> Cells(1, "A").Value2 Then
'run sub procedure here
'... run a macro ...'
'load A1's current value into the static var
s2d10 = Cells(1, "A").Value2
End If
End Sub
Selection_Change & Change
I went into a different direction and got lost. I think there might be some useful stuff in here, so here's the code anyway. It could be working in most conditions, just lose the 'str1' lines.
The 'str1' lines are for debugging purposes and show the behavior of the cells at different conditions.
Not sure if the sub ChangeD10 is emulating your conditions.
Throwing in the towel, but would appreciate any pinpointing of errors in the code.
Option Explicit
Private TargetValue As Variant
Private TargetAddress As String
Private Sub Worksheet_Change(ByVal Target As Range)
'The Playground
Const cStrWs1 As String = "Sheet1"
Const cStrWs2 As String = "Sheet2"
Const cStrCell1 As String = "A1"
Const cStrCell2 As String = "D10"
'Other Variables
Dim oWs1 As Worksheet
Dim oWs2 As Worksheet
Dim oRng As Range
Dim varA1_Before As Variant
Dim varA1_Now As Variant
'Debug
Const r1 As String = vbCr
Dim str1 As String
'Initialize
Set oWs1 = ThisWorkbook.Worksheets(cStrWs1)
Set oWs2 = ThisWorkbook.Worksheets(cStrWs2)
Set oRng = oWs2.Range(cStrCell2)
varA1_Before = oWs1.Range(cStrCell1).Value
str1 = "Worksheet_Change"
'Play
If Target.Address = oRng.Address Then
If Target.Value <> TargetValue Then
varA1_Now = oWs2.Range(cStrCell2).Value
oWs1.Range(cStrCell1).Value = varA1_Now
str1 = str1 & r1 & Space(1) & "Cell '" & cStrCell2 & "' changed " _
& "(Target.Value <> TargetValue)" & r1 & Space(2) _
& "Before: TargetValue (" & TargetAddress & ") = '" _
& TargetValue & "'," & r1 _
& " varA1_Before (" & Range(cStrCell1).Address _
& ") = " & varA1_Before & "'," & r1 & Space(2) _
& "Now: Target.Value (" & Target.Address & ") = '" _
& Target.Value & "'," & r1 _
& " varA1_Now (" & Range(cStrCell1).Address _
& ") = " & varA1_Now & "'."
Else
str1 = str1 & r1 & Space(1) & "Cell '" & cStrCell2 _
& "' didn't change. TargetValue = '" & TargetValue _
& "' and Target.Value = '" & Target.Value & "'."
End If
Else
str1 = str1 & r1 & Space(1) & "Cell '" & cStrCell2 _
& "' not changed. The Target.Address is '" _
& Target.Address & "', TargetValue is '" & TargetValue _
& "' and Target.Value is '" & Target.Value & "'."
End If
Debug.Print str1
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const r1 As String = vbCr
Dim str1 As String
str1 = "Worksheet_SelectionChange"
If Target.Cells.Count = 1 Then
str1 = str1 & r1 & Space(1) & "Cell '" & Target.Address _
& "' selected " & r1 & Space(2) _
& "Before: TargetValue (" & TargetAddress & ") = '" _
& TargetValue & "'," & r1 & Space(2) _
& "Now: Target.Value (" & Target.Address & ") = '" _
& Target.Value & "'."
TargetValue = Target.Value
TargetAddress = Target.Address
Else
str1 = str1 & r1 & Space(1) & "Multiple cells in range '" _
& Target.Address & "'."
End If
Debug.Print str1
End Sub
Sub ChangeD10()
ThisWorkbook.Worksheets("Sheet2").Cells(10, 4) = 22
End Sub
I'm trying to get my Sub to restart based on MsgBoxReults. The code I have doesn't contain any errors, but won't restart based on the users choice (hopefully, having an IF statement within another IF isn't the issue)
Please assist.
Sub ContinueWeatherList()
Dim Weather As String
'Assigning a Message Box result as a Variable for Yes/No
Dim MoreWeather As VbMsgBoxResult
Weather = InputBox("Type in the weather for " & Range("C1").End(xlDown) + 1)
If Weather = "" Then
MsgBox ("No data entered. Your response has not been recorded"), vbExclamation
Else
Range("C1").End(xlDown).Offset(1, 0).Value = Range("C1").End(xlDown) + 1
Range("A1").End(xlDown).Offset(1, 0).Value = Range("A1").End(xlDown) + 1
Range("B1").End(xlDown).Offset(1, 0).Value = Weather
Columns("A:C").EntireColumn.AutoFit
MsgBox "Thank you for entering your data " & vbNewLine & "Would you like to enter another?", vbYesNo
'Using IF statement to decide what happens for each condition
If MoreWeather = vbYes Then
''Call' command won't reinitiate Sub / *NEED TO FIX*
Call ContinueWeatherList
Else
MsgBox "Thank you for you input.", vbInformation
End If
End If
End Sub
Try the code below. You need to setup a variable to get the feedback from the VBYesNo MsgBox.
Option Explicit
Sub ContinueWeatherList()
Dim Weather As String
'Assigning a Message Box result as a Variable for Yes/No
Dim MoreWeather As Variant
' add label to restart to
ContinueWeatherList_Restart:
Weather = InputBox("Type in the weather for " & Range("C1").End(xlDown) + 1)
If Weather = "" Then
MsgBox ("No data entered. Your response has not been recorded"), vbExclamation
Else
Range("C1").End(xlDown).Offset(1, 0).Value = Range("C1").End(xlDown) + 1
Range("A1").End(xlDown).Offset(1, 0).Value = Range("A1").End(xlDown) + 1
Range("B1").End(xlDown).Offset(1, 0).Value = Weather
Columns("A:C").EntireColumn.AutoFit
MoreWeather = MsgBox("Thank you for entering your data " & vbNewLine & "Would you like to enter another?", vbYesNo)
'Using IF statement to decide what happens for each condition
If MoreWeather = vbYes Then
' use GOTo command and label to reinitiate the sub
GoTo ContinueWeatherList_Restart
Else
MsgBox "Thank you for you input.", vbInformation
End If
End If
End Sub
This moves the loop to a calling sub:
Sub EnterWeatherListItems()
Dim MoreWeather As VbMsgBoxResult
MoreWeather = vbYes
Do While MoreWeather = vbYes
Call FillWeatherList
'Assigning a Message Box result as a Variable for Yes/No
'Using IF statement to decide what happens for each condition
MoreWeather = MsgBox("Thank you for entering your data " & vbNewLine & "Would you like to enter another?", vbYesNo)
Loop
MsgBox "Thank you for you input.", vbInformation
End Sub
Sub FillWeatherList()
Dim Weather As String
Weather = InputBox("Type in the weather for " & Range("C1").End(xlDown) + 1)
If Weather = "" Then
MsgBox ("No data entered. Your response has not been recorded"), vbExclamation
Else
ActiveSheet.Range("C1").End(xlDown).Offset(1, 0).Value = ActiveSheet.Range("C1").End(xlDown) + 1
ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Value = ActiveSheet.Range("A1").End(xlDown) + 1
ActiveSheet.Range("B1").End(xlDown).Offset(1, 0).Value = Weather
Columns("A:C").EntireColumn.AutoFit
End If
End Sub
From #Shai Rado's answer but without gotos or variants
Option Explicit
Sub ContinueWeatherList()
Dim Weather As String
'Assigning a Message Box result as a Variable for Yes/No
Dim NoMoreWeather As Boolean
' Loop until user says otherwise
Do Until NoMoreWeather = vbNo
Weather = InputBox("Type in the weather for " & Range("C1").End(xlDown) + 1)
If Weather = "" Then
MsgBox ("No data entered. Your response has not been recorded"), vbExclamation
Else
Range("C1").End(xlDown).Offset(1, 0).Value = Range("C1").End(xlDown) + 1
Range("A1").End(xlDown).Offset(1, 0).Value = Range("A1").End(xlDown) + 1
Range("B1").End(xlDown).Offset(1, 0).Value = Weather
Columns("A:C").EntireColumn.AutoFit
NoMoreWeather = MsgBox("Thank you for entering your data " & vbNewLine & "Would you like to enter another?", vbYesNo)
End If
Loop
End Sub