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
Related
I'm trying to write a code to trace every change made by the user on any worksheet. The user will input data and from time to time will erase said data and/or correct the original value they inserted. If the change is either deletion or modification, an Userform will pop up and the user will include a reason for that change. Right now I'm able to display the form everytime the user makes one of the changes mentioned before, but I'm not able to retrieve the reason, could you guys help me?
This is what I have for the UserForm
Private Sub CommandButton1_Click()
Dim msgvalue As VbMsgBoxResult
Dim value As String
msgvalue = MsgBox("Do you wish to save the change?", vbYesNo + vbInformation, "Confirm")
If msgvalue = vbNo Then GoTo Command
If msgvalue = vbYes Then
value = UserForm1.txtCmmt.Value
If value = "" Then GoTo Command
End
End If
Command:
MsgBox ("A reason must be provided")
With UserForm1
.txtCmmt.Value = ""
End With
End Sub
So if a user tries to delete a value, the code is the following:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sLastAction As String
Dim Cell As Range
sLastAction = Application.CommandBars("Standard").Controls("&Undo").List(1)
For Each Cell In Target
If sLastAction = "Clear" Or sLastAction = "Delete" Or Left(sLastAction, 9) = "Typing ''" Then
UserForm1.Show 'this is where I'm stuck, I'm not sure how to retrieve the value from the form
End If
'the code continues to retrieve other info from the changes made, including the "reason"
Thanks for the help!
Try the next way, please:
Let us say that your text box where the comment will be written is named "txtComment".
Put this code in its Exit event:
Private Sub txtComment_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Me.txtComment.text <> "" Then
If ActiveSheet.Name <> "LogDetails" Then
Application.EnableEvents = False
Sheets("LogDetails").Range("A" & rows.count).End(xlUp).Offset(0, 5).Value = Me.txtComment.text
Application.EnableEvents = True
Unload Me
End If
End If
End Sub
Let the existing Worksheet_Change event as it is, only launching the form and maybe making a Public boolean variable (from a standard module) True (something boolStop) which will not allow changing anything in any worksheet until it is not False.
Then fill the text you need in the text box ("txtComment", or however you named it) and press Enter. If my above suggestion looks interesting for you, the last line of the text box event will be boolStop = False.
If you understand how to implement the above simple solution, you maybe will forget about a user form and use a simple InputBox, as in the next example:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) <> "E1" Then Exit Sub
Dim sLastAction As String, comValue As String
Dim Cell As Range
sLastAction = Application.CommandBars("Standard").Controls("&Undo").list(1)
For Each Cell In Target
If sLastAction = "Clear" Or sLastAction = "Delete" Or left(sLastAction, 9) = "Typing ''" Then
WritePlease:
comValue = InputBox("Please write the reason for cell """ & Cell.Address & """ (" & sLastAction & ").", "Reason, please")
If comValue = "" Then GoTo WritePlease
If ActiveSheet.Name <> "LogDetails" Then
Application.EnableEvents = False
'Stop
Sheets("LogDetails").Range("A" & rows.count).End(xlUp).Offset(0, 5).Value = comValue
Application.EnableEvents = True
End If
End If
Next
End Sub
I have looked and tried all the arrays and set functions but when I run it in the program it does not work.
This is my program
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Sheets("Check").Range("G16").Value = "Special Request" And _
Range("G17").Value = "" Or _
Range("G18").Value = "" Or _
Range("G19").Value = "" Or _
Range("G20").Value = "" Then
MsgBox "Please verify that all tabs are check using the check tab"
Cancel = True
End If
End Sub
Instead of naming each cell i would like to insert ranges. an example will be;
G17:G20 or
G24:G29 or
G33:G38 then_
If anyone has any suggestions it would be greatly appreciated
Use WorksheetFunction.CountA() to count the number of non blank values in the range and compare it against the ranges cell count.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Target As Range
Set Target = Range("G17:G20,G33:G38")
If Sheets("Check").Range("G16").Value = "Special Request" And _
WorksheetFunction.CountA(Target) < Target.count Then
MsgBox "Please verify that all tabs are check using the check tab"
Cancel = True
End If
End Sub
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 ?
I have an input box asking user to enter a date. How do I let the program know to stop if the user click cancel or close the input dialog instead of press okay.
Something like
if str=vbCancel then exit sub
Currently, user can hit OK or Cancel but the program still runs
str = InputBox(Prompt:="Enter Date MM/DD/YYY", _
Title:="Date Confirmation", Default:=Date)
If the user clicks Cancel, a zero-length string is returned. You can't differentiate this from entering an empty string. You can however make your own custom InputBox class...
EDIT to properly differentiate between empty string and cancel, according to this answer.
Your example
Private Sub test()
Dim result As String
result = InputBox("Enter Date MM/DD/YYY", "Date Confirmation", Now)
If StrPtr(result) = 0 Then
MsgBox ("User canceled!")
ElseIf result = vbNullString Then
MsgBox ("User didn't enter anything!")
Else
MsgBox ("User entered " & result)
End If
End Sub
Would tell the user they canceled when they delete the default string, or they click cancel.
See http://msdn.microsoft.com/en-us/library/6z0ak68w(v=vs.90).aspx
Following example uses InputBox method to validate user entry to unhide sheets:
Important thing here is to use wrap InputBox variable inside StrPtr so it could be compared to '0' when user chose to click 'x' icon on the InputBox.
Sub unhidesheet()
Dim ws As Worksheet
Dim pw As String
pw = InputBox("Enter Password to Unhide Sheets:", "Unhide Data Sheets")
If StrPtr(pw) = 0 Then
Exit Sub
ElseIf pw = NullString Then
Exit Sub
ElseIf pw = 123456 Then
For Each ws In ThisWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next
End If
End Sub
The solution above does not work in all InputBox-Cancel cases. Most notably, it does not work if you have to InputBox a Range.
For example, try the following InputBox for defining a custom range ('sRange', type:=8, requires Set + Application.InputBox) and you will get an error upon pressing Cancel:
Sub Cancel_Handler_WRONG()
Set sRange = Application.InputBox("Input custom range", _
"Cancel-press test", Selection.Address, Type:=8)
If StrPtr(sRange) = 0 Then 'I also tried with sRange.address and vbNullString
MsgBox ("Cancel pressed!")
Exit Sub
End If
MsgBox ("Your custom range is " & sRange.Address)
End Sub
The only thing that works, in this case, is an "On Error GoTo ErrorHandler" statement before the InputBox + ErrorHandler at the end:
Sub Cancel_Handler_OK()
On Error GoTo ErrorHandler
Set sRange = Application.InputBox("Input custom range", _
"Cancel-press test", Selection.Address, Type:=8)
MsgBox ("Your custom range is " & sRange.Address)
Exit Sub
ErrorHandler:
MsgBox ("Cancel pressed")
End Sub
So, the question is how to detect either an error or StrPtr()=0 with an If statement?
If your input box is an array, it does not work. I have solved it by adding a check for if it is an array first.
Dim MyArrayCheck As String
Dim MyPlateMapArray as variant
MyPlateMapArray = Application.InputBox("Select ....", Type:=8)
MyArrayCheck = IsArray(MyPlateMapArray)
If MyArrayCheck = "False" Then
Exit Sub
End If
I have solved it with a False like below
MyLLOQ = Application.InputBox("Type the LLOQ number...", Title:="LLOQ to be inserted in colored cells.", Type:=1)
If MyLLOQ = False Then Exit Sub
If user click cancel the sub will exit.
Another suggestion.
Create a message box when inputbox return null value. Example:
Dim PrC as string = MsgBox( _
"No data provided, do you want to cancel?", vbYesNo+vbQuestion, "Cancel?")
Sub TestInputBox()
Dim text As String
text = InputBox("Type some text")
If text = "" Then
MsgBox "button cancel pressed or nothing typed"
Else
MsgBox text
End If
End Sub
Inputbox send a boolean False value when Cancel is pressed.
contenidoy = Application.InputBox("Cantidad = ", titulox, contenidox, , , , , Type:=1)
'ESC or CANCEL
If contenidoy = False Then
MsgBox "Cancelado"
Else
MsgBox "Edición aceptada"
'End If
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".