Compile Error when using different VBA codes in same window - excel

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

Related

I'm looking to create a custom error message in Excel regarding a locked sheet using VBA

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

Mandatory Row of cells in an Excel Table

I am trying to make a row in my Excel table mandatory before users close the document, then display a pop-up message stating "cells require input".
I am running into an issue where users are still getting the pop-up message even if they have filled out all the mandatory cells.
This is a screenshot of what all I typed out. I have this in the workbook area
I am typing what's in the screenshot, in the workbook area, and have it to run beforeclose.
This is the what I used below. My required fields is the row A3-O3
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Cells(3, 1)(3, 2)(3, 3)(3, 4)(3, 5)(3, 6)(3, 7)(3, 8)(3, 9)(3, 10)(3, 11)(3, 12)(3, 13)(3, 14)(3, 15).Value = "" Then
MsgBox "Cell(s) require input", vbInformation, "Kutools for Excel"
Cancel = True
End If
End Sub
view of my spreadsheet
A plus would be a pop-up message letting the user know which cells are empty & for it to highlight the cells that are empty also
Use WorksheetFunction.CountBlank:
If Worksheetfunction.CountBlank(ActiveSheet.Range("A3:O3")) > 0 Then
MsgBox "Cell(s) require input", vbInformation
End If
Or SpecialCells(xlCellTypeBlanks):
On Error Resume Next
Dim rng As Range
Set rng = ActiveSheet.Range("A3:O3").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rng Is Nothing Then
MsgBox "Cell(s) " & rng.Address(False, False) & " require input", vbInformation
End If
Note that Cells(3, 1)(3, 2)(3, 3)(3, 4)(3, 5)(3, 6)(3, 7)(3, 8)(3, 9)(3, 10)(3, 11)(3, 12)(3, 13)(3, 14)(3, 15) does not refer to A3:O3.
In the Immediate Window, put:
? Cells(3, 1)(3, 2)(3, 3)(3, 4)(3, 5)(3, 6)(3, 7)(3, 8)(3, 9)(3, 10)(3, 11)(3, 12)(3, 13)(3, 14)(3, 15).Address
The result is
$DB$31

How to make a pop up alert while selecting a particular cell

I am trying to code in VBA for making a pop-up alert while selecting a particular cell, this is like a missing out of a mandatory field, it needs to display an alert for missed out cell while going on next cell
Sub macro1(ByVal Target As Range)
If Range("F3").Value = "NWOO" Then
If Not Intersect(Target, Range("E4:F4")) Is Nothing Then
MsgBox "You have missed a cell " & Target.Address & vbCrLf & "Please input a number", vbInformation, "Kutools for Excel"
' Macro1 Macro
' Keyboard Shortcut: Ctrl+z
End If
End Sub
You're close, the code is good. However, you need to code in a SelectionChange event, which will be triggered when a sheet's range selection changes.
Place sub below in your sheet's module:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("F3").Value = "NWOO" Then
If Not Intersect(Target, Range("E4:F4")) Is Nothing Then
MsgBox "You have missed a cell " & Target.Address & vbCrLf & "Please input a number", vbInformation, "Kutools for Excel"
End If
' Keyboard Shortcut: Ctrl+z
End If
End Sub
For the keyboard shortcut you will probably be better off using Application.Undo than using SendKeys. SendKeys can be very unreliable.

Showing COUNTIF results in a Message Box

I am currently using this code to display the number of "RCA Pending" found in a column. The message box does show the correct number of times it is found in the column, however, it creates a box for each instance (i.e. if there are 2 instances in the column, when the workbook is open it will display "Found 2 RCA Pending(s)", then when the user clicks OK, a second popup saying the same thing appears. If there are 5, you will get 5 consecutive popups).
Sub Auto_Open()
Dim row As Range
For Each row In Worksheets("Swivel").UsedRange.Rows
If row.Cells(1, "AB").Value = "RCA Pending" Then
MsgBox "Found " & WorksheetFunction.CountIf(Columns("AB"), "RCA Pending") & " RCA Pending(s)", vbInformation, "RCA Pending Found"
End If
Next row
End Sub
How can this be altered to show the total number of instances and not get multiple popups?
As a side note, I am using UsedRange because the range is always growing. The module that this code resides in has Option Explicit at the top.
Is this what you are trying?
Sub Auto_Open()
Dim instances As Long
instances = WorksheetFunction.CountIf(Columns("AB"), "RCA Pending")
If instances <> 0 Then _
MsgBox "Found " & instances & " RCA Pending(s)", vbInformation, "RCA Pending Found"
End Sub
OR
Sub Auto_Open()
Dim instances As Long
instances = WorksheetFunction.CountIf(Columns("AB"), "RCA Pending")
MsgBox "We Found " & instances & " instances of RCA Pending(s)", _
vbInformation, "RCA Pending Found"
End Sub

VBA code to refresh format as table filter in Excel

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

Resources