Hallo all i am trying to figure out the issue i have tried but not got successful. Can anyone please help me out in this . I shall be grateful to you.
Task:
I have a drop down list in excel like
Sales/Acquisition Manager (AM)-------------------------------Alina (Alina#yahoo.com)
Acquisition Project Manager (APM)--------------------------Benny(Benny#yahoo.com)
Manufacturing ----------------------------------------------------Julia(Julia#yahoo.com)
Application ---------------------------------------------------------please select (drop down list so I can choose)
AE external sensor responsible-------------------------------please select (Drop down list so I can choose)
I have made a separate row (row 59 Col A) where I have combined these values from the above rows.
I have to make a macro to send 1 email to these multiple people. I have written a code for sending email but I am stuck at some point. I have written a code which replaces the word please
select with “ ” whenever it finds in row 59 but unfortunately that code changes the line permanently which I don’t want.
What I want is that whenever it finds a word please select in a row it just ignores it and and also don’t change the format of cell. Means when I again change some new value by drop down list so it got changed. I shall be really grateful to you if you please help me out in this . Thanks a lot.please check the attached pics also.enter image description hereenter image description here
Private Sub CommandButton1_Click()
Dim the_string As String
the_string = Sheets("Schedule_team").Range("A59")
the_string = Replace(the_string, "please select", " ")
Sheets("Schedule_team").Range("A59") = the_string
MsgBox (Sheets("Schedule_team").Range("A59"))
Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long, x As
Variant
Set Mail_Object = CreateObject("Outlook.Application")
x = Cells (59, 1).Value
With Mail_Object.CreateItem(o)
' .Subject = Range("B1").Value
.To = x
' .Body = Range("B2").Value
' .Send
.display 'disable display and enable send to send automatically
End With
MsgBox "E-mail successfully sent", 64
Application.DisplayAlerts = False
Set Mail_Object = Nothing
End Sub
You don't put quotes around the_string inside the Replace()
the_string = Replace("the_string", "please select", " ")
should be:
the_string = Replace(the_string, "please select", " ")
Here's a slight refactoring of your code which removes the need for that variable:
Sub RemoveHypens()
With Sheets("Home").Range("A59")
.Value = Replace(.Value, "please select", " ")
End with
End Sub
EDIT: based on your updated question -
Private Sub CommandButton1_Click()
Dim the_string As String
Dim i As Integer, Mail_Object, Email_Subject, o As Variant
Dim lr As Long
the_string = Sheets("Schedule_team").Range("A59").Value
the_string = Replace(the_string, "please select", " ")
Set Mail_Object = CreateObject("Outlook.Application")
With Mail_Object.CreateItem(o)
'.Subject = Range("B1").Value
.To = the_string
'.Body = Range("B2").Value
'.Send
.display 'disable display and enable send to send automatically
End With
MsgBox "E-mail successfully sent", 64
Application.DisplayAlerts = False
Set Mail_Object = Nothing
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 am new to VBA. I am working hard and learning it but there is a point where I am stuck now. If someone please help me out then I shall be grateful.
I have a drop down list in excel like
Sales/Acquisition Manager (AM) Alina (Alina#yahoo.com)
Acquisition Project Manager (APM) Benny(Benny#yahoo.com)
Manufacturing Julia(Julia#yahoo.com)
Application please select (drop down list so I can choose)
AE external sensor responsible please select (Drop down list so I can choose)
I have made a separate row (row 59 Col A) where I have combined these values from the above rows.
I have to make a macro to send 1 email to these multiple people. I have written a code for sending email but I am stuck at another point. I have written code which replaces the words please select with “ ” whenever it finds it in row 59 but unfortunately that code changes the line permanently which I don’t want.
What I want is that whenever it finds the words please select in a row it just ignores it and and also doesn't change the format of cell. Means when I again change some new value by drop down list so it got changed.
Private Sub CommandButton1_Click()
Dim the_string As String
the_string = Sheets("Schedule_team").Range("A59")
the_string = Replace(the_string, "please select", " ")
Sheets("Schedule_team").Range("A59") = the_string
MsgBox (Sheets("Schedule_team").Range("A59"))
Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long, x As Variant
Set Mail_Object = CreateObject("Outlook.Application")
x = Cells (59, 1).Value
With Mail_Object.CreateItem(o)
' .Subject = Range("B1").Value
.To = x
' .Body = Range("B2").Value
' .Send
.display 'disable display and enable send to send automatically
End With
MsgBox "E-mail successfully sent", 64
Application.DisplayAlerts = False
Set Mail_Object = Nothing
End Sub
Pull the contents of A59 into the string, replace as needed, then just use that string instead of copying it back to the sheet.
Untested, just used your code
Private Sub CommandButton1_Click()
Dim Mail_Object as Object
Dim the_string As String
the_string = Sheets("Schedule_team").Range("A59")
the_string = Replace(the_string, "please select", " ")
Set Mail_Object = CreateObject("Outlook.Application")
With Mail_Object.CreateItem(o)
' .Subject = Range("B1")
.To = the_string
' .Body = Range("B2")
' .Send
.Display 'disable display and enable send to send automatically
End With
MsgBox "E-mail successfully sent", 64
End Sub
I am attempting to run through sheet 2 of an Excel workbook to email ranges to customers.
The ranges would be A1:B30,C1:D30,E1:F30 and so on with their account number in A1 & email in B1 and information below.
Every time I try to run the email it comes up with:
Run Time Error 1004
and then goes on to error
Object has been moved or deleted
Is there another way of emailing ranges or a way to amend this code?
Sub EmailRanges()
Dim cr As Range
Set cr = [b1]
ActiveWorkbook.EnvelopeVisible = True
Do While cr <> ""
cr.Offset(, -1).Resize(30, 2).Select
With ActiveSheet.MailEnvelope
.Introduction = " Good Morning"
.Item.To = cr
.Item.Subject = "Just testing, sorry for filling you inbox ^_^ "
.item.Send ' to send
.Item.Display ' to test
End With
MsgBox cr & " receives " & Selection.Address
Set cr = cr.Offset(, 2)
Loop
Application.ScreenUpdating = True
MsgBox "The Customers Have Been Notified"
End Sub
You need to be more explicit about your references (workbook, sheet, ...).
Thx to #Ralph :
A range can be only selected if the sheet is activated first. Otherwise, you'll get an error.
This run smoothly on my computer :
Sub Email_Ranges()
Dim rG As Range
Dim RangeToSend As Range
Dim CustomerMail As String
Set rG = ActiveWorkbook.ActiveSheet.[b1]
ActiveWorkbook.EnvelopeVisible = True
Do While rG.Value <> vbNullString
CustomerMail = rG.Value
Set RangeToSend = rG.Offset(, -1).Resize(30, 2)
'With RangeToSend.Parent.MailEnvelope
''Uncomment below if you get an error
rG.Parent.Activate
RangeToSend.Select
With Selection.Parent.MailEnvelope
.Introduction = "Good Morning"
With .Item
.To = CustomerMail
.Subject = "Just testing, sorry for filling your inbox ^_^ "
.display 'to test
.Send 'to send
End With
End With
Debug.Print CustomerMail & " receives " & RangeToSend.Address
Set rG = rG.Offset(, 2)
Loop
ActiveWorkbook.EnvelopeVisible = False
End Sub
I have images that I have assigned macros to in a worksheet and am trying to apply parameters to ensure that only valid entries are made. The spin button increase or decrease a cell value by a value of 1 on each click. I have used data validation criteria to only allow for values of 2 or greater (to avoid negative values, which don't exist, as well as using invalid references), but this only limits value entries when I type them in manually and is not firing when the buttons are used to decrease the values.
Is there a way to apply a sort of
.Min
.Max
function to these shape-buttons? I basically just do not want the user to be able to enter values below 2. Thanks!
Current Code:
Sub Increase_Val()
Dim StartRow As Long
Dim EndRow As Long
Dim row_number As Long
StartRow = Sheet6.Range("D5").Value
EndRow = Sheet6.Range("D5").Value
For row_number = StartRow To EndRow
DoEvents
Next row_number
End Sub
In your spin button macro, you can read the validation settings from the cell and decide whether to increment/decrement the number
Sub Tester()
Dim c As Range
Set c = Range("D4")
If Not c.Validation Is Nothing Then
If c.Validation.Type = xlValidateWholeNumber And _
c.Validation.Operator = xlBetween Then
Debug.Print "Min", c.Validation.Formula1
Debug.Print "Max", c.Validation.Formula2
End If
End If
End Sub
So my final solution ended up being a bit different than I was envisioning. Nixed the idea of a customized spin button using macros and images and went with the form control spin buttons. The full code uses information in a defined sheet that contains information and populates a generic message with personalized information and HTML formatting. My spin button was to help me pick what range of rows I wanted to include (since the function is using the .Display method rather than .Send as I wanted to personally check each email before it went out, and there were a lot of rows, this enabled me to more easily decide how many emails I wanted to display at one time). First the e-mail code (customized from an original work by Alex Cantu ):
Sub SendMyEmals(what_address As String, subject_line As String, mail_body_message As String)
Dim olApp As Outlook.Application
Dim oAttach As Outlook.Attachment
Set olApp = CreateObject("Outlook.Application")
Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = what_address
.Attachments.Add = "C:\",olByValue, 0
'your directory reference, I used this for my header image",
.Attachments.Add = "C:\",olByValue, 0
'other directory reference, used for footer image
.Subject = "Pick your subject"
.BodyFormat = olFormatHTML
.HTMLBody = "<img src='cid:"Your_image_name'"&"width = 'whatever' height = 'whatever' <br> <br>" mail_body_message & "&"img src='cid:Your_other_image'" &"width = 'whatever' height = 'whatever'>"
.Display
End With
End Sub
Sub MassEmail()
Dim mail_body_message As String
Dim A As String
Dim B As String
Dim C_name As String
Dim D As String
Dim RowStart As String
Dim RowEnd As String
Dim row_number As String
With Worksheets("Your_Worksheet")
RowStart = SheetX.Range("Your Range").Value
'this is the sheet where I stored the generic HTML message where I used replace text to be filled in by the row ranges from the main sheet "Your_Worksheet"
RowEnd = SheetX.Range("Your Other Range").Value
For row_number = RowStart To RowEnd
DoEvents
mail_body_message = SheetX.Range("Where the HTML was stored")
A = Sheet1.Range("A" & row_number)
B = Sheet1.Range("B" & row_number)
C = Sheet1.Range("C" & row_number)
D = Sheet1.Range("D" & row_number)
what_address = Sheet1.Range("D"& row_number)
'that is the column where I stored the individual email addresses
mail_body_message = Replace(mail_body_message, "replace_A_here", A)
mail_body_message = Replace(mail_body_message, "replace_B_here", B)
mail_body_message = Replace(mail_body_message, "replace_C_here", C)
mail_body_message = Replace(mail_body_message, "replace_D_here", D)
Call SendMyEmails(Sheet1.Range("D"&row_number), "This is a test email", mail_body_message
Next row_number
End With
End Sub
Anyway, it worked the way I was trying to get it to, I am sure there may have been more elegant ways to do it, but I am happy with this workaround for now.
Im new to VBA but i need to do something with it. I want to make input box that add a new sheet with specific name. somehow i can make it after some searching over the forum. here are the steps that i want to do, but i cant make it completely done.
make input box that ask a name of new sheet (it's done).
when the name of sheet is already available then a msg box appear
that it can't make a new sheet but when the opposite happen then a
new sheet is made (it's done too).
the last is i want to make when the input box is blank a new msg box
appear and ask to enter different name (this i can't do).
Here's the code im using so far
Public Sub CariSheet()
Dim SheetName As String
Dim shExists As Boolean
Do
SheetName = InputBox("Write the name of sheet", "Add Sheet")
If NamaSheet <> "" Then
shExists = SheetExists(SheetName)
If Not shExists Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SheetName
MsgBox "The sheet " & (SheetName) & " is successfuly made", , "Result"
Else
MsgBox "The name is already exist, please enter a new name", vbOKOnly + vbInformation, "Name"
End If
End If
Loop Until Not shExists Or SheetName = ""
End Sub
Private Function SheetExists(ByVal SheetName As String, _
Optional ByVal wb As Workbook)
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = Not wb.Worksheets(SheetName) Is Nothing
End Function
any help will be appreciated, thanks in advance for your attention. ah and sorry for my bad english.
Check if this code helps you:
Just added Else part for you Main If condition where you check If Sheetname is not blank.
Also, You can also uncomment my line Exit Sub if you want to exit subroutine in case of blank input box.
Public Sub CariSheet()
Dim SheetName As String
Dim shExists As Boolean
Do
SheetName = InputBox("Write the name of sheet", "Add Sheet")
If SheetName <> "" Then
shExists = SheetExists(SheetName)
If Not shExists Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SheetName
MsgBox "The sheet " & (SheetName) & " is successfuly made", , "Result"
Else
MsgBox "The name is already exist, please enter a new name", vbOKOnly + vbInformation, "Name"
End If
Else
MsgBox "Please enter a sheet name.", vbOKOnly + vbInformation, "Warning"
'Exit Sub
End If
Loop Until Not shExists Or SheetName = ""
End Sub
This code caters for errors for either:
the sheet name already existing
the sheet name being invalid (empty (ie ""), too long or invalid characters)
Code updates so sheet name is validated for length, and then by a Regexp for Valid characters for Excel sheet names before the sheet is created
If either 1 or 2 is true the user is re-prompted (with an additional try again message)
Public Sub CariSheet()
Dim SheetName As String
Dim bFinished As Boolean
Dim strMsg As String
Dim ws As Worksheet
Do While Not bFinished
SheetName = InputBox("Pls enter the name of the sheet", strMsg, "Add Sheet")
On Error Resume Next
Set ws = Sheets(SheetName)
On Error GoTo 0
If ws Is Nothing Then
Select Case Len(SheetName)
Case 0
strMsg = "Sheet name is blank"
Case Is > 31
strMsg = "Sheet name exceeds 31 characters"
Case Else
If ValidSheetName(SheetName) Then
Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = SheetName
Else
strMsg = "Sheet name has invalid characters"
End If
End Select
Else
strMsg = "Sheet exists"
Set ws = Nothing
End If
Loop
End Sub
test for valid sheet name
Function ValidSheetName(strIn As String) As Boolean
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "[\<\>\*\\\/\?|]"
ValidSheetName = Not objRegex.test(strIn)
End Function