I have the following macro to execute a before_print check. There are certain fields that must be populated in order for the user to print the template. The macro works fine but the message box will appear as many times as there is a blank field. Meaning if 3 of the 5 fields are blank then the message box will appear (3) times which means the user will have to close each message box.
Question: I would like to see what I would need to modify so that the message box only appears once regardless of how many of the required fields are left blank. All I care about is if any of the fields are blank to show the message box and cancel the print job.
Private Sub Workbook_BeforePrint(Cancel As Boolean)
If ActiveSheet.Name = "Template" Then
Dim jRange As Range
Set jRange = Sheets("Template").Range("C4,C5,B9,B10,B11")
For Each cell In jRange
If cell.Value = "" Then
MsgBox ("Cannot leave Invoice Number, Invoice Date or Vendor Name blank."), vbCritical
Cancel = True
End If
Next
End If
End Sub
Revised macro after assistance:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
If ActiveSheet.Name = "Template" Then
Dim jRange As Range
Set jRange = Sheets("Template").Range("C4,C5,B9,B8,B10")
Dim ReqFields As Boolean
For Each cell In jRange
If cell.Value = "" Then
ReqFields = True
End If
Next
If ReqFields Then
MsgBox ("Cannot leave Invoice Number, Invoice Date or Vendor Name blank."), vbCritical
Cancel = True
End If
End If
End Sub
Instead of showing a MsgBox each time through the loop, set a Boolean variable to "True". After the loop, if the Boolean is true, then you know that there was at least one field blank. At that point, show your error message and set "Cancel = True".
Related
I have this code but it only work for my first row.
It is suppose to look if the checkbox on B, C or D is checked, and if so, a date + username will automaticaly fill in F and G.
here is a picture of my table:
This is what my code looks like:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("B2") Or Range("C2") Or Range("D2") = True Then
Range("G2").Value = Environ("Username")
Range("F2").Value = Date
Else
Range("F2:G2").ClearContents
End If
End Sub
Enter this code in a regular module, select all your checkboxes and right-click >> assign macro then choose ReviewRows.
This will run the check whenever a checkbox is clicked - a bit of overhead since all rows will be checked, but should not be a big deal.
Sub ReviewRows()
Dim n As Long
For n = 1 To 100 'for example
With Sheet1.Rows(n)
If Application.CountIf(.Cells(2).Resize(1, 3), "TRUE") > 0 Then
If Len(.Cells(6).Value) = 0 Then 'only enter if currently empty?
.Cells(6) = Date
.Cells(7) = Environ("Username")
End If
Else
.Cells(6).Resize(1, 2).ClearContents
End If
End With
Next n
End Sub
If you want to be more precise then Application.Caller will give you the name of the checkbox which was clicked, and you can use that to find the appropriate row to check via the linkedCell.
Sub ReviewRows()
Dim n As Long, shp As CheckBox, c As Range, ws As Worksheet
Set ws = ActiveSheet
On Error Resume Next 'ignore error in case calling object is not a checkbox
Set shp = ActiveSheet.CheckBoxes(Application.Caller) 'get the clicked checkbox
On Error GoTo 0 'stop ignoring errors
If Not shp Is Nothing Then 'got a checkbox ?
If shp.LinkedCell <> "" Then 'does it have a linked cell ?
With ws.Range(shp.LinkedCell).EntireRow
If Application.CountIf(.Cells(2).Resize(1, 3), "TRUE") > 0 Then
If Len(.Cells(6).Value) = 0 Then 'only enter if currently empty?
.Cells(6) = Date
.Cells(7) = Environ("Username")
End If
Else
.Cells(6).Resize(1, 2).ClearContents
End If
End With
End If 'has linked cell
End If 'was a checkbox
End Sub
However this appraoch is sensitive to the exact positioning of your checkbox
You have a long way to go!
Unfortunately, If Range("B2") Or Range("C2") Or Range("D2") = True Then is beyond repair. In fact, your entire concept is.
Start with the concept: Technically speaking, checkboxes aren't on the worksheet. They are on a layer that is superimposed over the worksheet. They don't cause a worksheet event, nor are they responding to worksheet events. The good thing is that they have their own.
If Range("B2") Or Range("C2") Or Range("D2") = True Then conflates Range with Range.Value. One is an object (the cell), the other one of the object's properties. So, to insert sense into your syntax it would have to read, like, If Range("B2").Value = True Or Range("C2").Value = True Or Range("D2").Value = True Then. However this won't work because the trigger is wrong. The Worksheet_Change event won't fire when when a checkbox changes a cell's value, and the SelectionChange event is far too common to let it run indiscriminately in the hope of sometimes being right (like the broken clock that shows the correct time twice a day).
The answer, therefore is to capture the checkbox's click event.
Private Sub CheckBox1_Click()
If CheckBox1.Value = vbTrue Then
MsgBox "Clicked"
End If
End Sub
Whatever you want to do when the checkbox is checked must be done where it now shows a MsgBox. You can also take action when it is being unchecked.
I need to loop the below function to retrieve email address based on LAN IDs. Copied below code from an existing spreadsheet.
Requirement: Retrieve "Outlook email address" (Column A) based on "User LAN ID" (Column D).
fldUserLogonID is no longer 1 cell (it changes weekly) - depends how many "User LAN ID" comes through
Code below:
Private Sub CommandButton1_Click()
Dim user As String
Dim fldUserLogonID As String
If (ActiveSheet.range("fldUserLogonID").Value = "") Then
MsgBox "Please enter the User's Lan ID and then click on Populate Button"
Else
Call Module5.username1
Call Module5.FindUser
End If
Application.EnableEvents = True
Application.EnableEvents = False
If ActiveSheet.Range("User_ID").Value = "" Then
End Sub
Let's assume that the 500-values are listed in the range A1:A500.
Here is one way of looping through all of the values in the column:
Private Sub CommandButton1_Click()
Dim user As String
Dim fldUserLogonID As String
For i = 1 To 500
If (ActiveSheet.range("A" & I).Value = "") Then
MsgBox "Missing value at cell A" & I
'You may want to exit the loop when you encounter the first empty cell
'Otherwise, continue to the next cell below
Exit For
Else
Call Module5.username1
Call Module5.FindUser
End If
Next
Application.EnableEvents = True
End Sub
In my UserForm is a ComboBox, this ComboBox shows a list with more than 100 values. If I start typing some letters into the ComboBox I want that the dropdown-list will automatically only shows the values which has the typed letters (this works fine so far). But if I choose one value the ComboBox will stay empty.
Here is my code for the ComboBox:
Private Sub ComboBox1_Change()
Worksheets("DataSheet").Range("B1").Value = dbCustomer.Value
dbCustomer.RowSource = "=ddCustomer" 'Named Range
End Sub
In my Worksheet "DataSheet" in column "D" I wrote the formula:
=IFERROR(INDEX(Customer;AGGREGAT(15;6;(ROW(Customer)-1)/(--(SEARCH($B$1;Customer)>0));ZEILE()-1);1);"")
The named range "ddCustomer" I saved with:
=DataSheet!$D$2:INDEX(DataSheet!$D$2:$D$105;COUNTIF(DataSheet!$D$2:$D$105;"?*"))
What do I have to change, that the value which I choose will shown in the ComboBox?
EDIT
Could find a solution, maybe it is not perfect but it works fine for me.
Private Sub dbCustomer_Change()
Dim customer As Object
Set customerValue = Worksheets("DataSheet").Range("C2:C479").Find(dbCustomer.Value, LookIn:=xlValues, LookAt:=xlWhole)
If customerValue Is Nothing Then
dbCustomer.Clear
GoTo FillDB
Else
Worksheets("DataSheet").Range("B1").Value = ""
Exit Sub
End If
FillDB:
Worksheets("DataSheet").Range("B1").Value = dbCustomer.Value
For Each customer In Worksheets("DataSheet").Range("D2:D479")
If customer <> "" Then
dbCustomer.AddItem customer.Value
End If
Next
End Sub
Thanks Guys. I used the following code to get an error message to pop up if I attempt to save the sheet with one or more of the specified cells left blank. However, when I then go back and populate all the specified blank cells, and then save, I still get the error message. where am I going wrong?
Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Cell As Range
Dim flag As Boolean
flag = False
If Cells(1, 1) = "" Then flag = True
For Each Cell In Range("C9:C14")
If Cell = "" Then
flag = True
Exit For
End If
Next Cell
For Each Cell In Range("C18:C25")
If Cell = "" Then
flag = True
Exit For
End If
Next Cell
For Each Cell In Range("C30:E35")
If Cell = "" Then
flag = True
Exit For
End If
Next Cell
Cancel = flag
If flag Then MsgBox "error message"
End Sub
Here are 2 small functions checking if "a range" contains any empty cells and if sum of "one range" is equal to sum of "another range". I say this a bit abstract because your ranges may be larger tomorrow or in a different position and you may not want to recode your app time & again.
Function IsFilled(TestRange As Range) As Boolean
Dim C As Range
IsFilled = True
For Each C In TestRange.Cells
If C = "" Then
IsFilled = False
Exit For
End If
Next C
End Function
Function IsSum(TestRange As Range, TestSum As Range) As Boolean
IsSum = (Application.WorksheetFunction.Sum(TestRange) = Application.WorksheetFunction.Sum(TestSum))
End Function
In your context, both functions must evaluate to True for user entry to be valid.
Now you can
enter these functions into two cells of your worksheet (e.g. =isfilled(A2:A7), =issum(A3:A7;A2)) and tell users they have to work hard to make both True
evaluate the two results from above in any appropriate event Sub(), e.g. in a Worksheet_Deactivate(), Workbook_BeforeSave() (I prefer BeforeSave over BeforeClose as the user may want to escape w/o saving in which case I wouldn't need to validate)
directly call and evaluate these two functions from an appropriate event without using them in the worksheet
in any case the validating Sub() must terminate its default action and display a MsgBox() in case validation fails.
I have a workbook where several people will make an entry during the week.
Every entry is on its own row. Now i would like to have excel automatic insert the "Windows log-in name" of the user who made the entry, lets say on column K in that speciffic row.
I have found and tried to use the following script.
Function GetName(Optional NameType As String) As String
'Function purpose: To return the following names:
'Defaults to MS Office username if no parameter entered
'
'Formula should be entered as =GetName([param])
'
'For Name of Type Enter Text OR Enter #
'MS Office User Name "Office" 1 (or leave blank)
'Windows User Name "Windows" 2
'Computer Name "Computer" 3
'Force application to recalculate when necessary. If this
'function is only called from other VBA procedures, this
'section can be eliminated. (Req'd for cell use)
Application.Volatile
'Set value to Office if no parameter entered
If Len(NameType) = 0 Then NameType = "OFFICE"
'Identify parameter, assign result to GetName, and return
'error if invalid
Select Case UCase(NameType)
Case Is = "OFFICE", "1"
GetName = Application.UserName
Exit Function
Case Is = "WINDOWS", "2"
GetName = Environ("UserName")
Exit Function
Case Is = "COMPUTER", "3"
GetName = Environ("ComputerName")
Exit Function
Case Else
GetName = CVErr(xlErrValue)
End Select
End Function
I would then call GetName(2) from the relevant cell, but when a new user enter a new entry, all the previous user names are set to the new user.
Any help on this problem, are welcome
Thx
Taz
UPDATE:
Thx for the answers, they helped me get a bit further in solving my problem.
I have now come up with this code, but theres some strange things going on sometimes.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim User As String
User = Environ("UserName")
If Not Intersect(Target, Range("a7:a30")) Is Nothing Then
ActiveSheet.Unprotect
Application.EnableEvents = False
ActiveCell.Offset(0, 10).Value = User
Application.EnableEvents = True
ActiveSheet.Protect
End If
End Sub
This is pretty much working like it should, however it is possible to kinda fool the offset, so it will sometimes write the username only 9 offsets away.
Is it possible to change the code so i can write to a cell in a fixed column, on that row that is active ?
/Taz
With the help of this forum, i was able to make excel do what i wanted, i post the code here.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim row, col, user, ColCell As String
user = Environ("UserName")
col = "G" 'Set the Column ?
If Not Intersect(Target, Range("B7:B30")) Is Nothing Then
ActiveSheet.Unprotect
Application.EnableEvents = False
row = Split(Selection.Address, "$")(2) 'Get row number
ColCell = col & row
Range(ColCell).Value = user
'MsgBox "ColCell is : " & ColCell
Application.EnableEvents = True
ActiveSheet.Protect
End If
End Sub
But i have one question still, i have alot of sheets in my workbook, do i need to put this code in all the sheets, or is there a way that i can avoid this, and only have the code run from one place ?