I have an excel workbook, in one of the sheet we have sumiff formulas in 13 columns. these formulas are placed up to 15000 rows.
=SUMIFS($C:$C,$A:$A,A3,B:B,RIGHT($N$1,10))
all the formulas are deleting automatically some times, how to trace this or what is the cause of deleting all the formulas in 13 columns.
With the help of VBA you may find the cause.
Press Alt+F11 to bring the VBA editor.
Double click on the ThisWorkbook module of the Workbook having problems in left-top panel to edit it.
Add the following code (adapted from here)
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim aCell As Range
Dim del As Boolean
del = False
For Each aCell In Target.Cells ' Target may contain more than one cells.
'If aCell.Formula = "" Then ' Option #1
If Len(Trim(aCell.Value)) = 0 Then ' Option #2
'MsgBox "Cell " & aCell.Address & " in sheet " & Sh.Name & " has been cleared or deleted." ' Uncomment this line for further diagnostics
del = True
'Else ' Uncomment these two lines for further diagnostics
' MsgBox "Cell " & aCell.Address & " in sheet " & Sh.Name & " has been changed."
End If
If (del) Then Exit For
Next
MsgBox "At least on cell in range " & Target.Address & " in sheet " & Sh.Name & " has been cleared or deleted."
End Sub
Options #1 or #2 should work equally well.
You may uncomment some of the lines for further diagnostics.
It may become too verbose, and I expect it not be necessary.
You will need to save the workbook as .xlsm.
Related
I have an issue that I'm trying to resolve regarding the creation of a custom error message. I have a monthly workbook that we use to enter daily sales totals, and after each day we use a macro that locks all the cells and protects it from editing.
I want to create a custom error message when some one tries to edit the form.
I have found several solutions, but I cannot get them to work.
Here is what I have tried:
On each page I have this code to call the error:
Private Sub OnError()
If Target.Locked Then
Call ThisWorkbook.OnError
End If
End Sub
And in the ThisWorkbook page I created this sub to create the error code (copied and pasted from another forum):
Option Explicit
Sub Worksheet_Selection(ByVal Target As Range)
' Page lockout error code Visual Basic control
' Custom error code
Dim goodRng As Range
Dim wSheet As Worksheet
Set wSheet = ActiveSheet
If Target.Locked Then
Application.EnableEvents = False
wSheet.Locked = False
Application.EnableEvents = True
MsgBox "This day is closed." & vbNewLine & vbNewLine & _
"The day has been closed and" & vbNewLine & _
"further editing is prohibited!" & vbNewLine & _
"Thank you", vbCritical, "STOP!"
End If
End Sub
I have tried various iterations of this and am unable to get the error box to work. How can I get this to work?
I am a VBA novice.
Code edited due to new information from OP. Sounds like he is after code for a single sheet. Don't use the Worksheet_Activate code if it is not required and put the code in the relevant Sheet module, not ThisWorkbook module.
Private Sub Worksheet_Activate()
Call ShowCustomErrorMessage
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call ShowCustomErrorMessage
End Sub
Private Sub ShowCustomErrorMessage()
Application.EnableEvents = False
With ActiveSheet
.Unprotect Password:="1234" 'Edit to suit
.Cells.Locked = True
.Protect Password:="1234" 'Edit to suit
End With
Application.EnableEvents = True
MsgBox "This day is closed." & vbNewLine & vbNewLine & _
"The day has been closed and" & vbNewLine & _
"further editing is prohibited!" & vbNewLine & _
"Thank you", vbCritical, "STOP!"
End Sub
I have some VBA code that I would like to set the format (forecolour) of all cells in a given workbook that match some criteria (essentially this is to auto-mark use of a particular UDF). If the user has protected sheets in their workbook, they may have (sensibly) protected them in such a way that formatting is still permitted.
How do I check (from the VBA Range object representing the cell) whether a cell on any given worksheet is good to make format edits to?
I am aware the route-one answer to this will be an error handler to try it and handle the cases that fail - but as this has to run on every cell in the UsedRange of every sheet, I want it to be fast. I also realise that this is VBA, so there may not be a faster or more elegant way - but there is a lot of collected wisdom on here, hence my asking!
I think error handling is still the way to go. But as far as I can tell, if formatting fails for one cell in your sheet, it will fail for all other cells, even if those cell are unlocked.
Try the following strategy: The idea is that if formatting fails for any cell, you stop attempting to format the current sheet and move on to the next.
Sub MyProcedure()
Dim sht As Worksheet
Dim cl As Range
For Each sht In ThisWorkbook.Sheets
For Each cl In sht.UsedRange
On Error Resume Next
' Format the cell in a DIFFERENT procedure so that
' if an error occurs the rest of formatting lines are
' are not attempted (this is the key idea)
ApplyFormat cl
If Err.Description = "Application-defined or object-defined error" Then
Err.Clear
Exit For
End If
Next cl
'* Either reset your error handling here if you have more code for each sheet
On Error GoTo 0
' ...more code
Next sht
'* Or eset you error handling here
On Error GoTo 0
' ...more code
End Sub
Sub ApplyFormat(cl As Range)
' apply your formatting here
End Sub
You need to firstly check if the sheet is protected and do what you need if not.
If Protected, you should check only the range you try changing if is locked, has cells locked on is not and do the job only if is unlocked. You cannot check if the cells have a protected format... The next code will show you (I think) what is to be done in such a case:
Sub testSheetProtectedLockedCells()
Dim sh As Worksheet, rng As Range
Set sh = ActiveSheet: Set rng = sh.Range("A2:C4")
'Just for testing: _________________________________________
rng.Locked = Not rng.Locked 'lock - unlock the range...
rng.cells(1, 1).Locked = Not rng.cells(1, 1).Locked ' lock-unlock one cell of the range
'___________________________________________________________
If Not sh.ProtectionMode Then
DoIt rng
Else
If rng.Locked = False Then
DoIt rng
ElseIf IsNull(rng.Locked) Then
MsgBox "Cell(s) of the range """ & rng.address & """ are locked." & vbCrLf & _
"Please, unlock all the range and run the code again!", vbInformation, _
"Locked cells in the range to be processed..."
Else
MsgBox "The range """ & rng.address & """ is locked." & vbCrLf & _
"Please, unlock it and run the code again!", vbInformation, _
"Locked range to be processed..."
End If
End If
End Sub
Sub DoIt(rng As Range) 'do here the job you need...
Debug.Print rng.address, rng.Locked
End Sub
I'm using this vba code below, in Excel, to stop users from doing cut and paste and breaking formulas reference. The code itself works fine but it is creating an advert issue. The user will not be able to copy data from the workbook onto another workbook. Is there a work around it? Thanks
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, _
ByVal Target As Excel.Range)
Select Case Application.CutCopyMode
Case Is = False
'do nothing
Case Is = xlCopy
'do nothing
Case Is = xlCut
MsgBox "Please DO NOT Cut and Paste as it will break the formula reference." & vbNewLine & vbNewLine _
& "Use Copy and Paste, then delete the source.", vbCritical
Application.CutCopyMode = False 'clear clipboard and cancel cut
End Select
Rather than adding the code on the copy event, you need to handle the paste event. Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim UndoList As String
'Get the undo List to capture the last action performed by user
UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)
If Left(UndoList, 5) = "Paste" Then
Application.Undo
MsgBox "Please DO NOT Cut and Paste as it will break the formula reference."
& vbNewLine & vbNewLine _
& "Use Copy and Paste, then delete the source.", vbCritical
End If
End Sub
I have a number of things I want to achieve using VBA on a particular sheet.
1) Have a 3 button message box pop up when a certain condition is met.
2) Display the active cell address in a specific cell.
3) When hitting Enter after inputting data only to empty cells in a particular column, make the cursor jump to another column on the same row.
(Codes for each of these are at the end of the post)
I have the code to do all three of these things and they all work fine on their own, indeed the codes for items 1 & 2 also both work fine together, but when I add the code for item 3, a message box appears with
"Compile Error:
Ambiguous name detected: Worksheet_SelectionChange"
and the offending article in the code window is also highlighted.
I've noticed that the code for items 2 & 3 have the heading "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
If I remove the code for item 2, im then faced with a different message box
"Compile Error: Only comments may appear after End Sub, End Function, or End Property"
and highlights the words "Option Explicit" in the code window.
This also seems to break the code for item 1 as well.
I suspect the fact that I have two sets of code in the same window with the same "heading" might be the issue here. Is there a way for me to "blend" them so that they'll all play nicely with each other?
**---CODE FOR ITEM 1---**
Private Sub Worksheet_Calculate()
Dim r As Range
For Each r In Range("L:L")
If r.Value < 0 Then
result = MsgBox("You do not have enough stock to fulfil this request" & vbNewLine & vbNewLine & vbNewLine & _
"Please click: -" & vbNewLine & vbNewLine & _
" -Abort to order more stock" & vbNewLine & _
" -Retry to enter a different value" & vbNewLine & _
" -Ignore to receive stock", _
_
vbAbortRetryIgnore + vbDefaultButton2 + vbExclamation, "Negative Stock Level Warning")
End If
Next r
If result = vbAbort Then
MsgBox "Opening web browser", vbOKOnly + vbInformation, "New program warning!"
ActiveWorkbook.FollowHyperlink _
Address:="https://uk.rs-online.com/login", _
NewWindow:=True
End If
If result = vbRetry Then
MsgBox "Please enter a smaller parts count value", vbOKOnly + vbInformation, "Parts Count Input"
ActiveCell.Offset(-1, 0).Select
End If
If result = vbIgnore Then
MsgBox "You will now be directed to the Goods In window", vbOKOnly + vbInformation, "Receive Stock"
Sheets("Goods In").Activate
End If
End Sub
---CODE FOR ITEM 2---
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("A1048575") = ActiveCell.Address
End Sub
---CODE FOR ITEM 3---
Option Explicit
Dim emptyCell As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub ' don't bother with multicell selections
If Cells(1, Target.Column).Value <> "S.I.#" Then Exit Sub ' don't bother with selections outside "S.I.#" column
If emptyCell And Not IsEmpty(Target.Value) Then Cells(Target.Row, Range("A1", Cells(1, Columns.Count).End(xlToLeft)).Find(what:="Count", _
LookIn:=xlValues, lookat:=xlWhole).Column).Select ' if current cell was empty and now it is not then skip to "Count" column same row
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
emptyCell = IsEmpty(Target.Value) ' store the info about current selection being empty
End Sub
I have a format of table which is with filters and I made the filter to filter all the table based on the cells in column D3 that with value not blank. Now I am trying to make the filter work automatically based on any change on the list on cell G1.
I tried to use the pivot table but this did not work, as this type of table is not part of pivot table (formatted as table).
What is the correct code that can be used for such sorting?
The sheet is Sheet 1, the table named (PT).
The following code will be activated only if the value in G1 is changed.
Open VBE using Alt+F11, open "Sheet 1" module and paste the given code.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errH
If Not Intersect(Target, Me.Range("G1")) Is Nothing Then
Application.EnableEvents = False
'Put here things that you want to be done if G1 value is changed
'For example:
MsgBox "G1 was changed."
Application.EnableEvents = True
End If
Exit Sub
errH:
MsgBox ("Error number: " & Err.Number & ". Description: " & Err.Description)
Application.EnableEvents = True
End Sub
You can test it - just change the G1 value and you will see that it works.
However, I do not understand your explanation about what you want to filter. But whatever it is, just put the code in the place which I identified and remove that MsgBox.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim criteriaparameter As String
Dim criteriavalue As String
On Error GoTo errH
If Not Intersect(Target, Me.Range("G1")) Is Nothing Then
Application.EnableEvents = False
criteriaparameter = ActiveSheet.Range("J1").Value
criteriavalue = ">=" & criteriaparameter
ActiveSheet.Range("$A$8:$L$8").AutoFilter Field:=10, Criteria1:=criteriavalue, _
Operator:=xlAnd
Application.EnableEvents = True
End If
Exit Sub
errH:
MsgBox ("Error number: " & Err.Number & ". Description: " & Err.Description)
Application.EnableEvents = True
End Sub