I have code that looks like this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim searchFolder As String, fileName As String
Static PowerPointApp As Object
If Target.Column = 3 Then
If Target.CountLarge > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
With Application
Msg = .IfError(.VLookup(Target.Text, Worksheets("Test").Columns("A:B"), 2, 0), "")
If Msg <> "" Then MsgBox Target.Value & vbLf & vbLf & Msg, vbInformation, "Suggestion d'inspection"
End With
End If
End Sub
It checks a cell's content from Col A in Sheet 1 against a list from Sheet 2, Col 1; if there's a match, then a MsgBox will give info from the resulting cell's offset value from Col 2.
I'm trying to adapt this into another function that would do the same check, but then instead of displaying a message from the offset cell, it would open an hyperlink from that same cell.
As an example:
I put "Info X" in A:1 Sheet1; it checks in Col A Sheet 2 and if it has a match in A45 it will open the link from B45.
First check if the returned value from the vlookup is not equal to "". If not, then pass that value into the first argument of ActiveWorkbook.FollowHyperlink.
Edit:
Remove the two lines about msg and replace them with:
hlink = .VLookup(Target.Text, Worksheets("Test").Columns("A:B"), 2, 0)
If hlink <> "" Then
ActiveWorkbook.FollowHyperlink (hlink)
End If
You may need to declare hlink as a string variable.
Related
Getting a Run-Time Error 13 type mistmatch error when clicking cancel on a message box.
I tried making the following script to handle if a message box is empty, however upon bug checking, clicking cancel on the message box throws it all out.
Any ideas?
Private Sub ChangeDebtAmounts_Click()
Dim Debt1 As Integer, Debt2 As Integer, Debt3 As Integer, Debt4 As Integer
Dim D1Range As String, D2Range As String, D3Range As String, D4Range As String
D1Range = ActiveSheet.Range("Y15")
D2Range = ActiveSheet.Range("Y16")
D3Range = ActiveSheet.Range("Y17")
D4Range = ActiveSheet.Range("Y18")
Debt1 = InputBox("Please Enter in the account limit for " & D1Range)
If Debt1 = "" Then
MsgBox ("Setting " & D1Range & " to Zero, No Value Entered")
Else
Range("AA15").Value = Debt1 - Range("S58")
End If
End
End Sub
The type mismatch is with the InputBox rather than the MsgBox. To fix it, it is enough to change Dim Debt1 As Integer to Dim Debt1 As Variant. Also, you are using MsgBox as a sub rather than a function so the correct syntax should be
MsgBox "Setting " & D1Range & " to Zero, No Value Entered"
rather than
MsgBox ("Setting " & D1Range & " to Zero, No Value Entered")
In this case the parentheses are harmless, but if you try to give additional arguments to MsgBox while using it as a sub then you will get a syntax error.
Here's a slightly different take on your question. See my comments within the code.
(It's longer just because of the comments; optionally, you can remove any lines of comments, as well as any other blank lines.)
Private Sub ChangeDebtAmounts_Click()
Dim Debt1, Debt2, Debt3, Debt4 'data type "Variant" is assumed
Dim D1Range As String,D2Range As String,D3Range As String,D4Range As String
'by using a "With" statement, you can use "." instead of "ActiveSheet."
With ActiveSheet
D1Range = .Range("Y15")
D2Range = .Range("Y16")
D3Range = .Range("Y17")
D4Range = .Range("Y18")
'I added a title to the dialog and a default value of zero
Debt1=InputBox("Enter the account limit for " & D1Range, "Limit?" ,0)
'Check user response:
If Debt1 = "" Or Debt1 = 0 Then
'User clicked cancel or entered zero.
MsgBox "Setting " & D1Range & " to Zero, No Value Entered"
'I assume your next step is to set the input value to zero:
Debt1 = 0
Else
'you don't need to specify ".Value" in most cases (it's assumed)
'also:by using the "." we're referring to ActiveSheet again.
.Range("AA15") = Debt1 - .Range("S58")
End If
End With '(the end of "With ActiveSheet")
End Sub
A couple other thoughts:
it appears like you're going to use different variables for each InputBox but this is not necessary: you can re-use the same variable in this case, without issue.
ActiveSheet just refers to "whichever worksheet (tab) happens to be open when the code is run". It's a good idea to explicitly refer to a specific worksheet, to prevent potential problems in the future.
For example if your cells such as Y15 are on worksheet Sheet1, you could replace ActiveSheet with Sheets("Sheet1").
Alternate method (loop through all 4 cells)
These methods are for demonstration only - if you already have your solution figured out, stick with that, there's no point in wasting time! These are just to show other ways to do the same thing.
Just for fun, here's another alternate method, that loops through all 4 cells Y15:Y18 and repeats the same MsgBox's.
I wasn't sure what happens with the other 3 values the user enters, so I left those blank.
Private Sub demo_Alternate()
Dim userInput As Variant, arr As Variant, myCell
With Sheets("Sheet1") '<<<<<< change this to actual worksheet name
arr = .Range("Y15:Y18") ' arr(1) to arr(4) are now cell references
For Each myCell In arr
userInput = InputBox("Enter account limit for " & myCell, "Limit?", 0)
If userInput = "" Or userInput = 0 Then 'Cancelled or 0 entered
MsgBox "Setting " & myCell & " to Zero, No Value Entered"
userInput = 0
Else
Select Case Split(myCell.Address, "$")(2)
Case 15 'do what you need to for cell Y15
Range("AA15") = userInput - Range("S58")
Case 16
'do what you need to for cell Y16
Case 17
'do what you need to for cell Y16
Case 18
'do what you need to for cell Y16
End Select
End If
Next myCell 'loop to next cell
End With
End Sub
OR, if all four cells are getting from S58 and put into column AA of the same row, like:
...if your end-goal is the pattern:
AA15 = {Y15 or UserEntry} - S58
AA16 = {Y16 or UserEntry} - S58
AA17 = {Y17 or UserEntry} - S58
AA18 = {Y18 or UserEntry} - S58
...then something like this could work (and is even more compact).
Private Sub demo_Alternate2()
Dim userInput As Variant, arr As Variant, myCell, rowNum As Long
With Sheets("Sheet1") '<<<<<<<<<<<<< change this to actual worksheet name
arr = .Range("Y15:Y18") ' arr(1) to arr(4) are now cell references
For Each myCell In arr
userInput = InputBox("Enter account limit for " & myCell, "Limit?", 0)
If userInput = "" Or userInput = 0 Then 'Cancelled or 0 entered
MsgBox "Setting " & myCell & " to Zero, No Value Entered"
Else
rowNum = Split(myCell.Address, "$")(2)
Range("AA" & rowNum) = userInput - Range("S58")
End If
Next myCell
End With
End Sub
One noteworthy technique used here is the use of an array (arr) to read multiple cell values at once instead of a separate line for each cell input.
arr = .Range("Y15:Y18")
...assigns the four cells to the array so you can refer to the array as if:
arr(1) = Y15
arr(2) = Y16
arr(3) = Y17
arr(4) = Y18
I am trying to output specific error messages in my BeforeSave event. Here is the example message box: http://prntscr.com/jtlxt2.
For every use case the part has to be replaced by the defined error message from the specific test case. If there are multiple issues, all error messages should be printed in one message box. Here are the possible error messages:
1.Missing ID for the blockTemplate
2.The Parameter “ID” must be defined
3.The cell B2 is not allowed to be empty
4.Cell A2 contains an invalid value: “Ids”
5.Font Size must be an integer from 6 till 72
6.Paragraph Spacing Before must be an integer from 6 till 72
Font Size must be an integer from 6 till 72
Table "Column Variants":
7.The Variant IDs QINTRO_VAR1, QINTRO_VAR2 are not compatible with the global ID QUINTRO
8.The Cell C6 is not allowed to be empty. To define null for this value use the minus sign (-).
Here is the code I`ve written so far:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.EnableEvents = False
Dim cell As Range
Dim j As String
Dim i As Integer
Dim cellVal As Integer
Dim cellVal2 As Integer
Dim sCellVal As String
Dim a As Variant
Dim Target As Range
Dim arr As Range
Dim rngcheck As Range
Dim rngcheck2 As Range
sCellVal = Range("A2").Value
cellVal = Range("B3").Value
cellVal2 = Range("B4").Value
If Not IsNumeric(cellVal) Then
MsgBox "Only numeric values allowed."
End If
'If Sheets("General Info").Range("A2").Value = "" Then
'Cancel = True
'MsgBox "Save cancelled"
'End If
If Not sCellVal = "ID" Then
Cancel = True
MsgBox "The Parameter “ID” must be defined"
End If
If sCellVal = "" Then
Cancel = True
MsgBox "Missing ID for the blockTemplate"
End If
If sCellVal = "IDs" Then
'Cancel = True
MsgBox "Cell A2 contains an invalid value: “Ids”"
End If
If Not cellVal = (6 < 72) Then
MsgBox "Font Size must be an integer from 6 till 72"
End If
If Not cellVal2 = (6 < 72) Then
MsgBox "Paragraph Spacing Before must be an integer from 6 till 72"
End If
'Set arr = Range("C6:C7")
'If the columns is the eighth
'For Each a In arr
'ActiveSheet.Range("C6:C7").Select
'If Target.Column = 2 And (Target.Row > 5 And Target.Row < 8) Then
Set rngcheck2 = Range("C6:C7")
For Each cell In rngcheck2
If IsEmpty(cell) Then
MsgBox (" The cell" + Target.Address(0, 0)) + "is not allowed to be empty. To define null for this value use the minus sign (-)."
'The Cell C6 is not allowed to be empty. To define null for this value use the minus sign (-).
End If
Next cell
'Next a:
MsgBox (" The Variant IDs QINTRO_VAR1, QINTRO_VAR2 are not compatible with the global ID QUINTRO")
Set rngcheck = Range("B2:B4")
i = 0
For Each cell In rngcheck
If IsEmpty(cell) Then
i = i + 1
j = j & cell.Address & vbNewLine
End If
Next cell
If i = 0 Then Exit Sub
MsgBox "Sorry, you must enter a value in: " & vbNewLine & j
Application.EnableEvents = True
End Sub
I would build a message and then output it only once. Like:
Sub whatever()
Dim mess As String
mess = ""
If Not sCellVal = "ID" Then
Cancel = True
mess = mess & vbCrLf & "The Parameter “ID” must be defined"
End If
If sCellVal = "" Then
Cancel = True
mess = mess & vbCrLf & "Missing ID for the blockTemplate"
End If
' more code
If mess <> "" Then MsgBox mess
End Sub
Create a String called errorString.
Replace your existing "MsgBox " with "errorString=errorString & vbCrLf"
At the end of your routine check to see if there has been any errors (errorString contains something ) and then just msgbx errorString
If len(errorString)>0 Then
errorString = "Please correct the following Errors before continuing" & errorString (or whatever)
endif
Okay... this is not pretty, and it's partly because VBA wants to go line by line... so each error message needs to have its own block, such as:
Dim as as string, b as string, c as string
If sCellVal = "ID" Then a = "The Parameter “ID” must be defined."
If sCellVal = "" Then b = " Missing ID for the blockTemplate."
If sCellVal = "IDs" Then c = " Cell A2 contains an invalid value: “Ids.”"
MsgBox a & b & c 'Note that I put 2 spaces in front of the text above
You will want to group actions that use Cancel = True into one single grouping, and the non Cancel = True blocks into their own grouping. I would recommend the Cancel = True block appear second, so you can collect all possible error messages.
I have a report that is imported into excel every day, and the last column of information "Z", is all of the comments that have been left by previous agents working on the account. I am only interested in the last comment, but it can be of any length, so i cant just grab x amount of characters.
Question: Is there a way to only pull the last comment based on the criteria of the comment? (every comment ends with the username, date, and time-stamp:
Example of a cell:
Example of agent1 comment. [USERNAME1-xx/xx/xxxx xx:xx:xx PM] - Example of agent2 comment. [USERNAME2-xx/xx/xxxx xx:xx:xx PM])
In this scenario, the only text that i would want in the cell would be: "Example of agent2 comment.".
For the record, all of the imported report starts on "A2".
Guess I shouldn't do this as you haven't shown what you've tried yet, but this code should do the trick.
Enter in a cell: =ExtractLastComment(H3) where H3 contains the comment.
'Use this procedure to run on a range of cells.
'The result is placed one cell to the right of the comment: "Offset(, 1)"
Public Sub CommentsInColumn()
Dim rTarget As Range
Dim rCell As Range
Set rTarget = ThisWorkbook.Worksheets("Sheet1").Range("A2:A30")
For Each rCell In rTarget
rCell.Offset(, 1) = ExtractLastComment(rCell)
Next rCell
End Sub
Public Function ExtractLastComment(Target As Range) As Variant
Dim sCommentText As String
If HasComment(Target) Then
'Get the comment text.
sCommentText = Target.Comment.Text
If InStrRev(sCommentText, "[") <> 0 Then
'Find the last open bracket and take everything to the left of it.
sCommentText = Trim(Left(sCommentText, InStrRev(sCommentText, "[") - 1))
'Any closing brackets left?
If InStrRev(sCommentText, "]") <> 0 Then
'Take everything from last closing bracket to end of text.
sCommentText = Mid(sCommentText, InStrRev(sCommentText, "]") + 4)
End If
ExtractLastComment = sCommentText
Else
ExtractLastComment = CVErr(xlErrValue)
End If
Else
'There isn't a comment in the cell, return a !#NULL error.
ExtractLastComment = CVErr(xlErrNull)
End If
End Function
Public Function HasComment(Target As Range) As Boolean
On Error GoTo ERROR_HANDLER
If Target.Cells.Count = 1 Then
With Target
HasComment = Not .Comment Is Nothing
End With
Else
Err.Raise 513, "HasComment()", "Argument must reference single cell."
End If
On Error GoTo 0
Exit Function
ERROR_HANDLER:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure HasComment."
Err.Clear
Application.EnableEvents = True
End Select
End Function
I am trying to send out an email with updates when the the sheet are saved. To do this I am tracking changes and then trying to save these changes as a global string:
Public outString As String
Public Sub Worksheet_Change(ByVal Target As Range)
Dim colN, rowN As Integer
Dim changeHeading As String
Dim drawingNumber, partNumber As Integer
'Do nothing if more than one cell is changed or content deleted
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
'Stop any possible runtime errors and halting code
On Error Resume Next
Application.EnableEvents = False
colN = Target.Column
rowN = Target.Row
changeHeading = ThisWorkbook.Sheets("List").Cells(1, colN).Value 'Header of the changed cell
partNumber = ThisWorkbook.Sheets("List").Cells(rowN, 2).Value 'Partnumber changed
drawingNumber = ThisWorkbook.Sheets("List").Cells(rowN, 4).Value 'Drawingnumber changed
outString = outString & vbNewLine _
& "PartNumber: " & partNumber & " DrawingNumber: " & drawingNumber _
& " " & changeHeading & ": " & Target & vbNewLine
'Turn events back on
Application.EnableEvents = True
'Allow run time errors again
On Error GoTo 0
End Sub
So this piece of code works nice except if I alter several column on the same row then each change will be presented on a new line instead of the same line, Maybe i have to use a dictionary with partnumber as key to avoid this.
Then in thisworkbook sheet i have the following code
Public outString
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call track
Call missingDrawings
Call updateText
End Sub
However now the outString variable is , so what did I do wrong when declaring the global variable outString?
You seem to have two variables called outString one in the worksheet and one in the workbook. You should only have one. If you leave the one in thisWorkbook (adding As String would be a good idea), then you can access it from the sheet by using ThisWorkbook.outString.
Very new at VBA, I need something that sounds simple but I lack the knowledge or terminology to correctly research how to do this.
I need a way to loop through a column (we'll say D) to find value (X) and prompt a dropdown box from range (T2:T160) to replace value X for each individual occurance of X in rows rows 1 to 10000.
At the same for each time X is found, the value in that row for column B needs to be displayed (the user will query an external application to determine which of the values from the range needs to be set for that unique column B value)
1 b
2 y
3 x
4 t
5 x
and end like this
1 b
2 y
3 q
4 t
5 p
I setup my data like this:
Main code:
Sub findReplace()
Dim iReply As Integer
Dim strName As String
strName = InputBox(Prompt:="Enter Text to Search in Column D", Title:="Search Text", Default:="Enter value to find")
If strName = "Enter value to find" Or strName = vbNullString Then
Exit Sub
Else
For Each cell In Range("D1:D5")
If cell.Value = Trim(strName) Then
'Prompt to see if new value is required
iReply = MsgBox(Prompt:="Found " & strName & vbCrLf & "Value in column B is: " & cell.Offset(0, -2).Value & vbCrLf & "Do you wish to replace it?", _
Buttons:=vbYesNoCancel, Title:="UPDATE MACRO")
'Test response
If strName = "Your Name here" Or _
strName = vbNullString Then
Exit Sub
ElseIf iReply = vbYes Then
'Get new value
UserForm1.Show
ValueSelected = UserForm1.ComboBox1.Value
Unload UserForm1
If ValueSelected = vbNullString Or ValueSelected = "" Then
Exit Sub
Else
'Replace value
cell.Value = ValueSelected
End If
ElseIf iReplay = vbCancel Then
Exit Sub
End If
End If
Next cell
End If
End Sub
Setup a UserForm1 to display a drop down list to provide the user a selection option. Code behind form looks like this: (buttons have to be named the same to work correctly)
Private Sub bnt_Cancel_Click()
Unload Me
End Sub
Private Sub btn_Okay_Click()
Me.Hide
End Sub
Private Sub UserForm_Initialize()
'Populate dropdown list in userform
Dim rng As Range
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
For Each rng In ws.Range("T1:T10")
Me.ComboBox1.AddItem rng.Value
Next rng
End Sub
When you run it you'll get this sequence of popups:
I said no to the second replacement value so now my spread sheet looks like this: