So basically i am trying to do the following:
When a specific sheet is activated/selected, i want an input box to
be displayed.
From that input box i want to get a specific range that can be found
in that specific sheet.
Now, once that custom range is defined, i will use another private sub to analyze if the required conditions are met in that specific range (which was defined by the input box).
Below are the codes that i am currently using.
Private Sub Worksheet_Activate()
Dim x As Range
Set x = Application.InputBox(prompt:="Please select the range you want to be verified for results", Title:="Notifier", Default:="Ex: $A$5:$B$30", Type:=8)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range
Dim r As Range
Set objShell = CreateObject("Wscript.Shell")
Set A = x.Range
If Intersect(Target, A) Is Nothing Then Exit Sub
For Each r In Target
If r.Value = "FAIL" Then
intMessage = MsgBox("Please be aware that you have marked one of the required verification points as [Fail]" & vbCr _
& vbCr _
& "To improve the visibility over this issue please submit a new Jira ticket for it." & vbCr _
& vbCr _
& "Would you like to create the ticket now?", _
vbYesNo, "Notifier")
If intMessage = vbYes Then
objShell.Run ("https://custom_link")
Else
End If
End If
Next r
End Sub
Related
I have a workbook that is essentially an automated test, marking and feedback tool for end of topic tests for students. On the '701Test' sheetThey input their teaching group via a drop down list and the select their from subsequent list. They answer the multiple choice questions and press a button when finished. The button takes them to a 'results' page which gives their marks for each question, give feedback for incorrect answers and gives a total score. They then hit the finish button which generates a PDF copy of the mark sheet in their my documents folder and then emails a copy to themselves and the Schools email account. At this point I also wanted to post the final score to the students record on a central registry using a loop through the student list to find the name and offset to post the Score value from the 'Results' page and finally return to the test page. This last bit I wrote the code for in a module and it executes perfectly, but when added to the main code and run from the button the loop part fails to execute but the return to the test page does work, but no error is recorded for the loop failure.
Here is the 'Results' page code in full the 'With Central reg' bit at the bottom is the problem, any help is greatly appreciated.
Private Sub CommandButton1_Click()
Dim IsCreated As Boolean
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Dim cell As Range
Dim Students As Range
Title = Range("D1").Value
sname = Range("B2").Value
PdfFile = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\" & sname & Title & ".pdf"
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
With OutlApp.CreateItem(0)
.Subject = Title
.to = Range("B2").Value ' <-- Put email of the recipient here"
.CC = "" ' <-- Put email of 'copy to' recipient here
.Body = "Hi," & vbLf & vbLf _
& "Yr 7 701 EOT test attached in PDF format." & vbLf & vbLf _
& "Regards," & vbLf _
& "KDS ICT Dept" & vbLf & vbLf
.Attachments.Add PdfFile
Application.Visible = True
.Display
End With
If IsCreated Then OutlApp.Quit
Set OutlApp = Nothing
With CentralReg
For Each cell In Range("A2:A250")
If cell = Range("Results!B2").Value Then
cell.Offset(0, 4).Activate
ActiveCell.Value = Range("Results!B27").Value
End If
Next
End With
End Sub
I believe you are trying to refer to CentralReg which is a worksheet, which means you should qualify it as such.
Also, you should not dim variables that are similar to defined objects/properties in VBE. Try MyCell instead of cell (good practice, not required).
I am assuming you want to see if the value on sheet CentralReg in Column A is equal to sheet Result B2. If this condition is met, your MyCell will take on the value equal sheet Result B27
Dim MyCell As Range
Dim Result, NewValue as Variant
Result = ThisWorkbook.Sheets("Result").Range("B2")
NewValue = ThisWorkbook.Sheets("Result").Range("B27")
With ThisWorkbook.Sheets("CentralReg")
For Each MyCell In .Range("A2:A250")
If MyCell = Result Then MyCell.Offset(, 4) = NewValue
Next MyCell
End With
That with statement is useless as nothing actually uses it within the construct.
Delete with CentralReg and End with and it will work.
alternatively if CentralReg IS something like a sheet then you need to precede your code with a . so this: Range("A2:A250") becomes this: .Range("A2:A250") and so on, the . tells the code that it is related to whatever your with construct surrounds
I have written a code to display old and new values of a cell and then store the message box display data to another sheet one after another...
Option Explicit
Dim OldVals As New Dictionary
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
Dim sMsg As String
Dim rg As Range
Dim lr As Integer
For Each myCell In Target
If OldVals.Exists(myCell.Address) Then
sMsg = "New value of " & Replace(myCell.Address, "$", "") & " is " & myCell.Value & "; old value was " & OldVals(myCell.Address)
MsgBox sMsg
If MsgBox(sMsg) = vbOK Then Set rg = ThisWorkbook.Sheets("Sheet2").Range("A1")
lr = rg.CurrentRegion.Rows.Count
rg.Offset(lr, 0).Value = sMsg
Else
MsgBox "No old value for " + Replace(myCell.Address, "$", "")
End If
OldVals(myCell.Address) = myCell.Value
Next myCell
End Sub
In my code when I press enter after entering the cell value the message box will come and display the old and new values like below picture --.
But I want to display this message box only after saving the cell value after pressing ctrl+s key not by pressing enter key or any other key .
Only after pressing Ctrl+s to save the cell value the message box will come as above but I am not able to figure that out kindly help me.
You can assign Ctrl+s to a Macro
Public Sub SaveWorkbook()
ActiveWorkbook.Save
'Your code here
End Sub
I am currently attempting to self-teach myself the great world of macro coding in VBA but have come across a stumbling block when trying to process 3 macros that I would ideally like to process as 1 but the code seems to be far too complicated for me at this stage.
What I need is to convert data from US date format mm/dd/yyyy into UK date format dd.mm.yyyy and changing the / to . at the same time ideally overwriting the original data.
This is currently what I have in separate Modules:
Sub FixFormat()
'display a message with an option if US date formats are
'included in the data
MsgBox "US Date Formats Included", vbQuestion + vbYesNo, "Addresses"
If Response = Yes Then MsgBox "Delimit Process Needed", vbOKOnly, "Addresses"
If Response = No Then MsgBox "End", vbOKOnly
End
End Sub
and
Sub FixDates()
Dim cell As Range
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Range("A1:A" & lastRow)
If InStr(cell.Value, ".") <> 0 Then
cell.Value = RegexReplace(cell.Value, _
"(\d{2})\.(\d{2})\.(\d{4})", "$3.$2.$1")
End If
If InStr(cell.Value, "/") <> 0 Then
cell.Value = RegexReplace(cell.Value, _
"(\d{2})/(\d{2})/(\d{4})", "$3.$1.$2")
End If
cell.NumberFormat = "yyyy-mm-d;#"
Next
End Sub
Function RegexReplace(ByVal text As String, _
ByVal replace_what As String, _
ByVal replace_with As String) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = replace_what
RE.Global = True
RegexReplace = RE.Replace(text, replace_with)
End Function
Is there any way to do this without having to run 2 separate macros?
Yes, you can Call the subroutine you want to run as a result of the message box.
Sub FixFormat()
'display a message with an option if US date formats are
'included in the data
If MsgBox("US Date Formats Included", vbQuestion + vbYesNo, "Addresses") = 6 Then
MsgBox "Delimit Process Needed", vbOKOnly, "Addresses"
Call FixDates
Else
MsgBox "End", vbOKOnly
End If
End Sub
See this link for more information on the MsgBox function: http://msdn.microsoft.com/en-us/library/139z2azd(v=vs.90).aspx
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: