I am trying to make sure data is entered into the InputBox at each stage otherwise I want the message to pop-up and the entry to end.
I have a MsgBox that pops up if nothing is entered but I want to add an option to have the Sub remain at the InputBox so the user can still enter the data.
I've tried vbRetryCancel and either the Retry will loop and then never cancel (and I have to force Outlook to close to end the macro) or the Cancel will loop and it will never retry.
If I could make it so the InputBox would not advance with "Ok" until data is entered or "cancel" was clicked that would work too but I would still need a MsgBox if nothing is entered to alert the user.
Sub Request_Tracking()
Dim objMsg As MailItem
Dim tasksource As String
Set objMsg = Application.CreateItem(olMailItem)
'requests input of the user with various options
tasksource = InputBox("Please select task receipt method:" & _
vbCrLf & vbTab & "1 - Phone call" & _
vbCrLf & vbTab & "2 - Email" & _
vbCrLf & vbTab & "3 - Instant Message" & _
vbCrLf & vbTab & "4 - Desk walk-up" & _
vbCrLf & vbTab & "5 - Miscellaneous", "Option Chooser")
'if response is blank then ends the task
If tasksource = vbNullString Then
MsgBox "Nothing was entered. Please re-enter your request.", vbOKOnly, "Error!"
Exit Sub
End If
Select Case tasksource
Case "1"
tasksource = "Phone call"
Case "2"
tasksource = "Email"
Case "3"
tasksource = "Instant Message"
Case "4"
tasksource = "Desk walk-up"
Case "5"
tasksource = "Miscellaneous"
Case Else
tasksource = tasksource
End Select
'various input boxes for data needed, if response is blank then ends the task without send
strName = InputBox("Requestor Name:")
If strName = vbNullString Then
MsgBox "Nothing was entered. Please reattempt your request.", vbOKOnly, "Error"
Exit Sub
End If
strCoreEvent = InputBox("Task Description:")
If strCoreEvent = vbNullString Then
MsgBox "Nothing was entered. Please reattempt your request.", vbOKOnly, "Error"
Exit Sub
End If
strUnitNum = InputBox("Number of units:")
If strUnitNum = vbNullString Then
MsgBox "Nothing was entered. Please reattempt your request.", vbOKOnly, "Error"
Exit Sub
End If
strTime = InputBox("Processing Time:")
If strTime = vbNullString Then
MsgBox "Nothing was entered. Please reattempt your request.", vbOKOnly, "Error"
Exit Sub
End If
'configures message being sent, sents to WFM box and formats the body font and various line breaks and then sends
With objMsg
.To = "tracking#test.com"
.Subject = "Request Received"
.HTMLBody = "<body style=font-size:11pt;font-family:Arial><b>For request tracking; please assign to me.</b>" & "<p>" & tasksource & " request from " & strName & ": " & strCoreEvent & "<br />Number of units: " & strUnitNum & "<br />Processing time: " & strTime & "</p></body>"
.Recipients.ResolveAll
.Send
End With
End Sub
Your can try something like this:
While tasksource = " "
tasksource = InputBox("Please select task receipt method:" & _
vbCrLf & vbTab & "1 - Phone call" & _
vbCrLf & vbTab & "2 - Email" & _
vbCrLf & vbTab & "3 - Instant Message" & _
vbCrLf & vbTab & "4 - Desk walk-up" & _
vbCrLf & vbTab & "5 - Miscellaneous", "Option Chooser", " ")
If tasksource = vbNullString Then
Exit Sub
ElseIf (tasksource = " ") Then
tasksourceCancel = MsgBox("Nothing was entered. Please re-enter your request. Or press Cancel to leave!", vbOKCancel, "Error!")
If tasksourceCancel = 2 Then
Exit Sub
End If
End If
Wend
It forces the user to have Input, if user clicks OK the return/default value will be " " (space) will loop, if the user clicks cancel the value will be vbNullString and it will exit.
Try something like this
Do
tasksource = InputBox("Please select task receipt method:" & _
vbCrLf & vbTab & "1 - Phone call" & _
vbCrLf & vbTab & "2 - Email" & _
vbCrLf & vbTab & "3 - Instant Message" & _
vbCrLf & vbTab & "4 - Desk walk-up" & _
vbCrLf & vbTab & "5 - Miscellaneous", "Option Chooser", 1)
If Not (tasksource >=1 And tasksource <=5) Then
optionvar = MsgBox("Incorrect selection. Do you want to re-enter your request?", vbYesNo, "Input required")
If optionvar = 6 Then 'if yes is pressed
tasksource = vbNullString
Else
tasksource = optionvar
End If
End If
Loop While tasksource = vbNullString
Related
The email is able to be sent out but I keep receiving this error. This wasn't a problem before, the code worked fine and I was able to update a table field DateEmailSent but now that field can't be updated. This only happened after I created another form, could it be that the code in that form affected the code here.
Option Compare Database
Function GenerateEmail(MySQL As String)
On Error GoTo Exit_Function:
Dim oOutLook As Outlook.Application
Dim oEmailItem As Mailitem
Dim currentDate As Date
currentDate = Date
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset(MySQL)
'MsgBox rs.RecordCount
If rs.RecordCount > 0 Then
rs.MoveFirst
' MsgBox rs!Email
Do Until rs.EOF
If IsNull(rs!Email) Then
rs.MoveNext
Else
If oOutLook Is Nothing Then
Set oOutLook = New Outlook.Application
End If
Set oEmailItem = oOutLook.CreateItem(olMailitem)
With oEmailItem
.To = rs!Email
.CC = "josleasecollection#jos.com.sg"
.Subject = "End of Lease Product Collection Notification - " & rs!IDATender & " " & rs!PONumber & " CUSTOMER NAME: " & rs!AgencyName
.Body = "Dear Customer, " & vbCr & vbCr & _
"Notification of End of Lease Collection" & vbCr & _
"This is to inform you that leasing product(s) for PO #" & rs!PONumber & " will be expiring on " & rs!DueDate & vbCr & vbCr & _
"For a smooth and seamless collection process, you are required to: " & vbCr & _
" - To appoint a single contact point (Name, email and mobile contacts) for coordination purposes." & vbCr & _
" - To make verifications on the lease items for collection" & vbCr & _
" - To consolidate lease equipment & allocate holding are for onsite work purposes." & vbCr & _
" - To provide site clearance access if there are entry restrictions." & vbCr & _
" - To remove any additional parts (i.e. RAM, Additional HD, Graphic cards) installed in the lease equipment that is not part of the lease contract and BIOS password lock." & vbCr & _
" - To sign off all necessary asset & collection forms upon validations." & vbCr & vbCr & _
"Important Terms: " & vbCr & _
" 1. Lease equipment must be return in full and good working condition (with the exception of fair wear & tear)." & vbCr & _
" For Desktop, items to be collected with main unit as follows:" & vbCr & _
" - Power Adapter/Cable, Keyboard, Mouse" & vbCr & vbCr & _
" For Notebook, items to be collected with main unit as follows:" & vbCr & _
" - Power Adapter, Carrying case, Mouse" & vbCr & vbCr & _
" For Monitor, items to be collected with main unit as follows:" & vbCr & _
" - VGA Cable" & vbCr & vbCr & _
" 2. Any loss of lease equipment, you are required to immediately inform JOS and we will advise the relevant procedures." & vbCr & _
" 3. Collection must be completed no later than 14 days after the expiry of lease. We reserve the right to impose a late return fees (calculated on a daily basis) for any lease equipment." & vbCr & _
" 4. JOS will send in onsite engineers for asset verification and assist you. If onsite engineers are not available, JOS will provide a handbook for hard disk removal before collection, to which you shall immediately conduct the hard disk removal at your end." & vbCr & _
" 5. JOS shall not be held liable for any non-removal of any additional parts." & vbCr & _
" 6. JOS shall be indemnified in the event that collection is unsuccessful by the termination date due to the default or unreasonable delay caused by the customer. " & vbCr & _
" Appreciate for your acknowledgement by replying to josleasecollection#jos.com.sg by " & currentDate
.Send
rs.Edit
rs!dateemailsent = Date
rs.Update
End With
Set oEmailItem = Nothing
Set oOutLook = Nothing
rs.MoveNext
End If
Loop
Else
End If
This is the code for the new form i created.
Option Compare Database
Private Sub btnUpdateEmail_Click()
On Error GoTo Exit_UpdateEmail
Email_Update:
Dim db As DAO.Database
Dim qdf As QueryDef
Dim sql As String
Set db = CurrentDb()
Set qdf = db.QueryDefs("qryUpdateEmail")
sqlString = "UPDATE Company SET Company.Email = '" & Me.txtNewEmail & "' WHERE Company.ContractNumber = '" & Me.txtContractNumber & "' "
qdf.sql = sqlString
If Nz(Me.txtContractNumber, "") = "" Then
MsgBox "Please enter a contract number"
Resume Exit_Update
ElseIf Nz(Me.txtNewEmail, "") = "" Then
MsgBox "Please enter a new email address"
Resume Exit_Update
End If
DoCmd.OpenQuery "qryUpdateEmail"
Exit_Update:
Exit Sub
Exit_UpdateEmail:
If Err.Number = 2501 Then
Resume Exit_Update
Else
MsgBox Err.Description
Resume Exit_Update
End If
End Sub
rs.Close
Exit_Function:
Exit Function
End Function
I am trying to find if some mandatory values are filled in particular cells or not. But When I try to find value of cell AI and BM, excel throws me Error 1004 but it works fine for cells X and Y. Any idea how to correct this?
Row 1 has my headers.
Private Sub CommandButton1_Click()
Dim value As Range, sheetRange As Range
Dim j As Integer
Dim lRow As Integer
Set sheetRange = Sheet4.Range("A2:BM65536")
On Error Resume Next
Set value = Intersect(sheetRange.EntireRow.SpecialCells(xlConstants), sheetRange)
On Error GoTo 0
If value Is Nothing Then
MsgBox "Good to go"
Exit Sub
Else
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To lRow
If Len(Sheet4.Range("X" & j).value) = 0 Then
MsgBox "Enter value for: Data sheet" & vbNewLine & "Column name: " & Range("X1").value & vbNewLine & "Cell X" & j, vbExclamation
Exit Sub
End If
If Len(Sheet4.Range("Y" & j).value) = 0 Then
MsgBox "Enter value for: Data sheet" & vbNewLine & "Column name: " & Range("Y1").value & vbNewLine & "Cell Y" & j, vbExclamation
Exit Sub
End If
If Len(Sheet4.Range("AB" & j).value) = 0 Then
MsgBox "Enter value for: Data sheet" & vbNewLine & "Column name: " & Range("AB1").value & vbNewLine & "Cell AB" & j, vbExclamation
Exit Sub
End If
If Len(Sheet4.Range("AI" & j).value) = 0 Then
MsgBox "Enter value for: Data sheet" & vbNewLine & "Column name: " & Range("AI").value & vbNewLine & "Cell AI" & j, vbExclamation
Exit Sub
End If
If Len(Sheet4.Range("BM" & j).value) = 0 Then
MsgBox "Enter value for: Data sheet" & vbNewLine & "Column name: " & Range("BM").value & vbNewLine & "Cell BM" & j, vbExclamation
Exit Sub
End If
Next
End If
End Sub
The issue is that in your MsgBox line of AI and BM the & Range("AI").value & returns an array of values, because AI is the whole column.
You probably meant to use & Range("AI1").value & to return the header name only.
Same for & Range("BM").value &.
I have code in Excel which sends email to a list of recipients:
Sub SendEMail()
Dim xEmail As String
Dim xSubj As String
Dim xMsg As String
Dim xURL As String
Dim i As Integer
Dim k As Double
Dim xCell As Range
Dim xRg As Range
Dim xTxt As String
On Error Resume Next
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select the data range:", "Send emails to:", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
If xRg.Columns.Count <> 3 Then
MsgBox "Incorrect number of columns: You have to choose Name, Email address, Account no.!"
Exit Sub
End If
For i = 1 To xRg.Rows.Count
' Get the email address
xEmail = xRg.Cells(i, 2)
' Message subject
xSubj = "Your customer's account is on hold"
' Compose the message
xMsg = ""
xMsg = xMsg & "Dear client" & "," & vbCrLf & vbCrLf
xMsg = xMsg & "We would like to inform you, that Your account has been put on hold - "
xMsg = xMsg & xRg.Cells(i, 3).Text & "." & vbCrLf & vbCrLf
xMsg = xMsg & "If you have any queries, please contact us on uk.ar#bodycote.com." & vbCrLf & vbCrLf
xMsg = xMsg & "Kind regards," & vbCrLf
xMsg = xMsg & "Jon and Martina"
' Replace spaces with %20 (hex)
xSubj = Application.WorksheetFunction.Substitute(xSubj, " ", "%20")
xMsg = Application.WorksheetFunction.Substitute(xMsg, " ", "%20")
' Replace carriage returns with %0D%0A (hex)
xMsg = Application.WorksheetFunction.Substitute(xMsg, vbCrLf, "%0D%0A")
' Create the URL
xURL = "mailto:" & xEmail & "?subject=" & xSubj & "&body=" & xMsg
' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, xURL, vbNullString, vbNullString, vbNormalFocus
' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Next
End Sub
I would like to add variable attachments. It will be a pdf file and its name will be the same as the name of customer (which is placed in column A). Basically it should look for "Name.pdf" in "S:\All Team\AX OTI\test\"
The source table looks like:
Please try to use the below code.
xMsg = xMsg & "Dear client" & xRg.Cells(i, 1) & "," & vbCrLf & vbCrLf 'Added the client Name (optional) you can remove it
xMsg = xMsg & "We would like to inform you, that Your account has been put on hold - "
xMsg = xMsg & xRg.Cells(i, 3).Text & "." & vbCrLf & vbCrLf
xMsg = xMsg & "If you have any queries, please contact us on uk.ar#bodycote.com." & vbCrLf & vbCrLf
xMsg = xMsg & "Kind regards," & vbCrLf
xMsg = xMsg & "Jon and Martina" & vbCrLf & vbCrLf 'Added two break point
' Replace spaces with %20 (hex)
xSubj = Application.WorksheetFunction.Substitute(xSubj, " ", "%20")
xMsg = Application.WorksheetFunction.Substitute(xMsg, " ", "%20")
' Replace carriage returns with %0D%0A (hex)
xMsg = Application.WorksheetFunction.Substitute(xMsg, vbCrLf, "%0D%0A")
' Create the URL
xURL = "mailto:" & xEmail & "?subject=" & xSubj & "&body=" & xMsg &"&attachment=S:\All Team\AX OTI\test\" & Cells(i,1) & ".pdf" 'Changed to this
' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, xURL, vbNullString, vbNullString, vbNormalFocus
' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Based on #Vityata advice, I've checked the question and based on that, I' ve changed the code. It is tested and works smoothly. The code is much easier, but the job is done.
Sub SendEmail()
Dim Mail_Object, OutApp As Variant
With ActiveSheet
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row 'list of recipients (email address) - it takes as many addresses as B column contains
End With
For i = 2 To lastrow
Set Mail_Object = CreateObject("Outlook.Application")
Set OutApp = Mail_Object.CreateItem(0)
With OutApp
.Subject = "Your customer's account is on hold"
.Body = "Dear client" & "," & vbCrLf & vbCrLf & "We would like to inform you, that Your account has been put on hold." & vbCrLf & vbCrLf & "If you have any queries, please contact us on uk.ar#bodycote.com." & vbCrLf & vbCrLf & "Kind regards," & vbCrLf & "Jon and Martina"
.To = Cells(i, 2).Value
strLocation = "S:\All team\AX OTI\test\" & Cells(i, 1) & ".pdf"
.Attachments.Add (strLocation)
.display
'.send
End With
Next i
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub
Here you have something that works really nicely - Add attachement to outlook with varying file names
In your case, simply copy the code and make sure that in the part strLocation you write something like:
strLocation = "C:\Users\user\Desktop\" & Cells(i,2) & ".pdf"
thus, you will be able to loop around it. In general, take a good look at the mentioned answer, it is really a good approach (IMHO quite better than sending keys).
My code works perfectly if the selected cell you tell it to delete is filled out with one of the part #'s from the drop down list.
But if you type in a new or custom # then want to delete that part # later the macro returns a
Type mismatch (Error 13)
Sub DeleteRows()
Application.ScreenUpdating = False
On Error GoTo whoa
If ActiveCell.Row <= 8 Then
MsgBox "Ooops!" & vbNewLine & _
vbNewLine & "Please select a Part Number"
ElseIf MsgBox("Are you sure you want to delete this part?" & vbNewLine & _
vbNewLine & _
ActiveCell.EntireRow.Cells(1, "A").Value & vbNewLine & _
ActiveCell.EntireRow.Cells(1, "B").Value & vbNewLine & _
"QTY: " & ActiveCell.EntireRow.Cells(1, "M").Value, _
vbYesNo) = vbYes Then
ActiveCell.Resize(3, 1).EntireRow.Delete
End If
Application.ScreenUpdating = True
Exit Sub
whoa:
MsgBox "Please select a number from the drop down list" & vbNewLine & _
"then run the delete command again.", vbInformation, Err.Description
End Sub
How can I get rid of that error and still have it delete the 3 rows (each part is 3 rows) if I enter a custom #.
Thanks
The following code looks for certain text strings in a column and gives a msg box whenever something matches. The code looks for more than one text string, so if I have "X" AND "y" in one column and the code looks for both text strings, then two msg boxes will appear. I only want the first msg box to show and hide the rest. Is there a way to do this?
In other words, code looks for multiple text strings, pops up msg boxes if text strings match. More than one text string will definitely match, but I want only the first box to appear, and hide the rest.
Thanks
Private Sub Worksheet_Change(ByVal Target As Range)
Dim icounter As Long
Dim icounter1 As Long
Dim lastrow As Long
Dim MSG As String, ans As Variant
For icounter = 2 To 31
If Cells(icounter, 2) = "Job Code Name" Then
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. PS Group" & vbNewLine & "2. Level" & vbNewLine & "3. Box Level" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
ElseIf Cells(icounter, 2) = "Personnel Area" Then
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. Personnel Subarea" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
ElseIf Cells(icounter, 2) = "Line of Sight" Then
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. 1 Up Line of Sight" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
ElseIf Cells(icounter, 2) = "Title of Position" Then
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. Job Code Name" & vbNewLine & "2. PS Group" & vbNewLine & "3. PS Level" & vbNewLine & "4. Box Level" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
ElseIf Cells(icounter, 2) = "Company Code Name" Then
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. Cost Center" & vbNewLine & "2. Line of Sight" & vbNewLine & "3. 1 Up Line of Sight" & vbNewLine & "4. Personnel Area" & vbNewLine & "5. Location" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
ElseIf Cells(icounter, 2) = "Function" Then
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. Sub Function" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
Else
End If
Next icounter
End Sub
If I understand your question, you could use Select Case instead of all the If...ElseIf stuff. Just reading the comments. Apparently you want to exit the For loop as well so add Exit For.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim icounter As Long
Dim icounter1 As Long
Dim lastrow As Long
Dim MSG As String, ans As Variant
For icounter = 2 To 31
Select Case Cells(icounter, 2)
Case "Job Code Name"
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. PS Group" & vbNewLine & "2. Level" & vbNewLine & "3. Box Level" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
Exit For
Case "Personnel Area"
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. Personnel Subarea" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
Exit For
Case "Line of Sight"
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. 1 Up Line of Sight" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
Exit For
Case "Title of Position"
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. Job Code Name" & vbNewLine & "2. PS Group" & vbNewLine & "3. PS Level" & vbNewLine & "4. Box Level" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
Exit For
Case "Company Code Name"
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. Cost Center" & vbNewLine & "2. Line of Sight" & vbNewLine & "3. 1 Up Line of Sight" & vbNewLine & "4. Personnel Area" & vbNewLine & "5. Location" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
Exit For
Case "Function"
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. Sub Function" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
Exit For
End Select
Next icounter
End Sub
I would recommend you another refactoring in your code. Since you are using a Worksheet event, every time you change a cell content it will fire that event, so I believe you add Application.EnableEvents = False before your For loop and Application.EnableEvents = True after it.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim icounter As Long
Dim icounter1 As Long
Dim lastrow As Long
Dim MSG As String, ans As Variant
Application.EnableEvents = False
For icounter = 2 To 31
Select Case Cells(icounter, 2)
Case "Job Code Name"
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. PS Group" & vbNewLine & "2. Level" & vbNewLine & "3. Box Level" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
Exit For
Case "Personnel Area"
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. Personnel Subarea" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
Exit For
Case "Line of Sight"
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. 1 Up Line of Sight" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
Exit For
Case "Title of Position"
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. Job Code Name" & vbNewLine & "2. PS Group" & vbNewLine & "3. PS Level" & vbNewLine & "4. Box Level" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
Exit For
Case "Company Code Name"
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. Cost Center" & vbNewLine & "2. Line of Sight" & vbNewLine & "3. 1 Up Line of Sight" & vbNewLine & "4. Personnel Area" & vbNewLine & "5. Location" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
Exit For
Case "Function"
MsgBox ("Please note you may need to add in additional attributes under this field" & vbNewLine & vbNewLine & "1. Sub Function" & vbNewLine & vbNewLine & "Please add in these additional fields as needed")
Exit For
End Select
Next icounter
Application.EnableEvents = False
End Sub
I used Tim's answer but it fired whenever I made an edit to any cell in the sheet. To avoid this, I added this line of code before Select Case Cells(icounter, 2):
If Not Intersect(Target, Cells(icounter, 2)) Is Nothing Then
This edit has made the msg box pop up only when cells change to the string text I inputted, i.e. company code name