What would be the best way to write a VBA code to have a message box pop up if the value in one cell is less than or greater than another cell - and then display the difference?
Column N contains total appts (manual input)
Column R contains total results (formula generated)
If the cell in column R after calculated is less than or greater than the cell in column N the message box would pop up and say Total results is less than appts by # or Total results is greater than appts by #.
Add the following routine to your required sheet in the VBA project (e.g. Sheet1)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("N1") Or Target = Range("R1") Then 'Only attempt to run the below code if target is a range you care about
If Range("R1").Value2 <> Range("N1").Value2 Then
MsgBox "Values differ"
End If
End If
End Sub
On the assumption that you want to compare two cells with one another (as opposed to a whole column of cells):
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("N1") > Range("R1") Then
MsgBox "Oops. Results less than Input by " & Abs(Range("N1") - Range("R1"))
End If
If Range("N1") < Range("R1") Then
MsgBox "Oops. Results greater than Input by " & Abs(Range("N1") - Range("R1"))
End If
End Sub
That should achieve the following:
Compare two cells with one another whenever the sheet changes (regardless whether it be the formula generated value for R1, the manual input for N1, or anything else on the sheet)
Identify which is greater
Pop up an appropriate message
Related
I am testing a command button to run three checks on an internal stock requisition sheet ("TestOrder") in excel 2007. Where the basic premise is that from a list of inventory parts(goods), the user can enter the quantity required of item/s and specify the customer code for who the goods are for. If any of the required fields are empty then a message will appear and the procedure stops.
They must enter their initials as the Requisitioner from a drop down list in one dedicated cell (D2), and select initials of the user who will process the request from another drop down list in the dedicated cell (F2). Quantities will be entered into the appropriate Row of column L, and the customer code in the same row of column M. This sheet will then be filtered and emailed for processing.
I have, in the main got all of that working, but due to time constraints I had not been able to work on a way of checking that all the data required has been entered prior to the filtered order being emailed anywhere.
I need to check three things:
Step 1, Have both sets of initials been entered
Step 2, If quantities have been entered, then the customer field cannot be blank
Step 3, If a customer has been entered then the quantity field cannot be blank.
So, all three steps have to have data in their cells.
I have got Step 1 working as the dedicated cells D2 and F2 do not change, if either cell is blank, a message appears to the user and stops the procedure.
Whereas the quantities required in column L and the customer codes in column M are variable and would be subject to a filter to remove blanks and show only what has been ordered.
So, I was working up a test initially on a single column (M-customer codes) to check if the number of non-empty cells in range is less than total number of cells in range and this is where the Run time error 424 occurred.
On the line
Set myCellRange = Range("M7:M" & Range("M" & Rows.Count).End(xlUp).Row).Select
where M7 is the top cell of the listed data in that column.
My work in progress code is:
Sub btn_test_checkdata()
' On the click of this button run a check to see if two cells have the required data, in this case they would be Users Initials selected from a drop down list cell'
If [D2].Value = "" Then
MsgBox "There MUST be Initials selected in the Who is ordering Field", vbOKOnly, "Entry Reqd"
[D2].Select
Cancel = True
Exit Sub
End If
If [F2].Value = "" Then
MsgBox "There MUST be Initials selected in the Who is the Req'n being sent to Field", vbOKOnly, "Entry Reqd"
[F2].Select
Cancel = True
Exit Sub
End If
'Sub checkIfAnyCellInRangeIsEmpty()
'declare object variable to hold reference to cell range you work with
Dim myCellRange As Range
'identify cell range you work with
Set myCellRange = Range("M7:M" & Range("M" & Rows.Count).End(xlUp).Row).Select
'check if number of non-empty cells in range is less than total number of cells in range. Depending on result, display message box indicating whether cell range contains any empty cell (True) or not (False)
If WorksheetFunction.CountA(myCellRange) < myCellRange.Count Then
MsgBox myCellRange.Address & " contains at least 1 empty cell"
End If
End Sub
Obviously, I need to extend this check to both columns so any hints on that would be great, as I'm not an expert user my thinking would have me get the code to work for one column then repeat it for the other.
The current error I'm getting now, has it something to do with specifying the worksheet? As I cannot see me doing that anywhere.
Like I say, I have the main operations working in the order sheet, and this is about me building a small procedure to do a final check before anything else happens.
The comment from John Coleman should do the job (move the .Select action):
Dim myCellRange As Range
Set myCellRange = Range("M7:M" & Range("M" & Rows.Count).End(xlUp).Row)
myCellRange.Select '<- this action
I have a workbook with a two sheets, Rep and Aux.
I want to dynamically set Aux!A2 to the value of the ActiveCell, which is on sheet Rep, but only if the ActiveCell is on column D of that sheet (in the range Rep!D2:D5000).
To top it all of I need this mechanism to run as long as the workbook is active, not just a one-shot.
For example: While being on sheet Rep I place the cursor, i.e. ActiveCell on cell D2. I expect Aux!A2 to be set to the value of Rep!D2. I move the cursor to, say, Rep!F5 and expect nothing to happen to Aux!A2, lastly, I activate cell Rep!D7 and again, expect Aux!A2 to get the ActiveCell's value. Continue till I close the workbook.
My VBA skills are non-existent and Googling, the only thing remotely close to what I described was:
Sub Macro1()
If Not Intersect(ActiveCell, Sheets("Rep").Range("D2:D5000")) Is Nothing Then Sheets("Aux").Range("A2").Value = ActiveCell.Value
End Sub
Which fails completely.
Put this in the code of the "Rep" worksheet. Triggers anytime a cell is selected on that sheet, if the cell is in column 4 (D) then it sets the value of the cell on Aux to match.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Column = 4 Then
ThisWorkbook.Worksheets("Aux").Cells(2, 1).value = Target.Value
End If
End Sub
EDIT: In response to comments.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
End Sub
This subroutine is an event that exists on every worksheet. Any time a selection changes it will run any code you put in it. The "ByVal Target as Excel.Range" part is saying it's giving you a copy of the target range being selected, because you could select more then one cell.
If Target.Column = 4 Then
end if
This is an If Block. If the condition is true, any code between the "Then" and the "End If" will execute. The condition is if the target's column is 4 in this case.
ThisWorkbook.Worksheets("Aux").Cells(2, 1).value = Target.Value
This sets the cell at row 2 column 1 value to match the value of the target that was selected.
Now that I think about it I wonder what this code will do if you select a range of cells.....
I am trying to find if a user deletes values in certain cells in column B then cells in same rows in column X are also deleted using worksheet_change function.
When I delete only one cell in column B then IsEmpty(Target) returns true and I am able to clear the same row cell in column X.
However, when select multiple cells in column B and press delete button, the IsEmpty(Target) returns False. Now here Target is range of multiple cells. I just can't find a way to find if a user has deleted range of values in column B at the same time. Any help would be much appreciated.
Below code works when one cell is deleted but not when a range of cells are deleted.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
If Target.Columns.Count > 1 Then Exit Sub
If IsEmpty(Target) Then
Application.EnableEvents = False
ActiveSheet.Range("X" & Target.Row & ":X" & Target.Row + Target.Rows.Count - 1).ClearContents
Application.EnableEvents = True
End If
End Sub
Thanks
Uttam
You misunderstand the purpose of the function IsEmpty.
I guess what you are really looking for are cells which do not contain a value (blank cells). The following line will give you the count of cells which contain a value. If that is equal to zero then they are all blank.
Target.SpecialCells(xlCellTypeConstants).Count
Yet, the above line of code will result in an error if all cells are empty. Hence, you will have to adjust your code as follows:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
If Target.Columns.Count > 1 Then Exit Sub
Dim bolIsEmpty As Boolean
On Error GoTo AllAreEmpty
bolIsEmpty = Target.SpecialCells(xlCellTypeConstants).Count = 0
On Error GoTo 0
If bolIsEmpty Then
' ... your code here ...
End If
Exit Sub
AllAreEmpty:
bolIsEmpty = True
Resume Next
End Sub
Copy the column in question into a hidden worksheet (workSheet.Visible = xlVeryHidden), then use WorksheetFunction.CountA to compare the number of non-empty cells in the column of the visible worksheet and in the 'shadow' column of the hidden worksheet. This will quickly inform you if the number of cells with contents has decreased (i.e., contents have been deleted).
If so, get the .UsedRange of the observed column, find the first empty cell in it and check if the corresponding cell in the shadow column is empty as well. If yes, continue to the next empty cell; if not, you know the cell content has been deleted, and you can delete the corresponding cell content in your 'column X'.
After each Worksheet_Change event you need to make another 'shadow' copy.
this is my first question so please bear with me if i'm doing anything wrong.
Quick back storey... on sheet "Purchase" in column C i want the item name of what has been purchased, in column D i want the quantity and in column G i want the location of where the item is going. For example i want 10 boxes of tiles delivered to the office. C2=Tiles, D2=10, G2=Office
When the location of an item is entered into column G(cell change) i want the macro to offset to the same row in column C and then search for the value in column A on sheet "Office", i currently have this for searching if a cell changes;
Private Sub worksheet_change(ByVal target As Range)
Dim keycells As String
keycells = "g2:g9999"
If Application.Intersect(ActiveCell, Range(keycells)) = "Office" Then MsgBox "hello"
End Sub
This does work, but it also checks if all other cells change, which i dont want it to do this. In place of "msgbox "hello" " i want to put the script for it to offset to the same row in column C look at the value and then search for this value in column A on sheet "Office".
If it is found i need the macro to add the newly purchased quantity to the current quantity on sheet "Office" (this will be column B), if it is not found i need it add the information from columns C & D on sheet "Purchase" to columns A & B
Also i will need to add more locations to the script and will give these locations a sheet in the workbook over time
If this is possible i will be extremely gratefull for all help provided
The Worksheet_Change event fires on all cell changes.
To prevent your code running unless the cell is in column G, you could restrict it like this:
Private Sub worksheet_change(ByVal target As Range)
Dim keycells As String
Dim iSect
If target.Column = 7 Then
keycells = "g2:g9999"
Set iSect = Application.Intersect(target, Range(keycells))
If Not iSect Is Nothing Then
If lcase(target) = "office" Then
MsgBox "hello"
' add code here to copy the data
End If
End If
End If
End Sub
However, a better solution might be to use formulas (such as an array formula or using INDEX and MATCH) in the target worksheets to extract the data - this will avoid using a macro entirely.
I have this function which is trying to detect when a particular cell value changes. The problem is, if the user selects the whole spreadsheet and presses delete, I get an overflow in my check that the range is only a single cell:
Public Sub Worksheet_Change(ByVal Target As Range)
'Overflow can occur here if range = whole spreadsheet
If Not IsError(Int(Target.Cells.Count)) Then
If Target.Cells.Count = 1 Then
If Target.Cells.Row = 4 And Target.Cells.Column = 1 Then
Sheets("X").Cells(5, 1).Calculate
End If
End If
End If
End Sub
Is there a more elegant way that I can get this code to only run, when a single particular cell value is changed? (with no overflows, problems when I clear the whole worksheet etc)?
I'm assuming you are on Excel 2007+ since the number of rows and columns increased dramatically in those versions. You might have better luck checking to make sure both the row and column count = 1, since those maxes will be much lower than the product of the two (ie, the cell count):
If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
Use CountLarge instead of Count
Private Sub Worksheet_SelectionChange(ByVal target As Range)
If target.Cells.CountLarge > 1 Then Exit Sub
'Code...
End Sub
See: MSDN Range.CountLarge Property (Excel)