Help in VBA Coding (dowhile/ loopuntil)

gvreddyhr

New Member
Joined
May 5, 2010
Messages
26
Hi All,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
<o:p> </o:p>
Hope everyone are doing good, Am in need of your help.<o:p></o:p>
<o:p> </o:p>
I have created a payroll application using some VBA and worksheet functions as well, everything is working fine, but I am getting struck in pay slip processing, for Payslip creation I created one sheet and used vlookup function, if I key in the employee number, all other particulars will update, and I have created a mail icon which converts that particular range to pdf and generates email, now its becoming very difficult for me to do the same action for all employees.<o:p></o:p>
<o:p> </o:p>
So am looking where macro automatically runs and generate email for all at a time, below is the more details<o:p></o:p>
<o:p> </o:p>
Ex:-<o:p></o:p>
Sheet name “payslip” in cell “A5” I need to update the employee number, I have the list of applicable employee numbers in sheet “Maillist” from “a2 to X (xldown / end)”, now I want to write a code where it works as<o:p></o:p>
1. Copy from sheet “Maillist” cell “a2” and paste in sheet “payslip” cell “A5” and then run the mailer code(converts in to pdf and generates email)<o:p></o:p>
2. Copy from sheet “Maillist” cell “a3” and paste in sheet “payslip” cell “A5” and then run the mailer code(generate email)<o:p></o:p>
3. Copy from sheet “Maillist” cell “a4” and paste in sheet “payslip” cell “A5” and then run the mailer code(generate email)<o:p></o:p>
.<o:p></o:p>
.<o:p></o:p>
.<o:p></o:p>
.<o:p></o:p>
.<o:p></o:p>
Copy from sheet “Maillist” cell “a100”(xldown) and paste in sheet “payslip” cell “A5” and then run the mailer code(generate email).<o:p></o:p>
<o:p> </o:p>
<o:p> </o:p>
I have the code which automatically convert particular range to pdf and generates email, can anyone help me to get the above code..<o:p></o:p>
<o:p> </o:p>
Thanks in advance<o:p></o:p>
<o:p> </o:p>
Regards,<o:p></o:p>
GV Reddy<o:p></o:p>
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Code:
    Dim cell As Range
    
    With Sheets("Maillist")
        For Each cell In .Range("A2", .Range("A2").End(xlDown))
            Sheets("payslip").Range("A5").Value = cell.Value
            [COLOR="Green"]'  run the mailer code(generate email) here[/COLOR]
        Next cell
    End With
 
Upvote 0
Hi,

I did as per your instruction, but it again generates only one email, can you see where am going wrong in the below code

PHP:
Public Sub bulkemail_payslip()
Dim cell As Range
    
    With Sheets("Bulkmaillist")
        For Each cell In .Range("C2", .Range("C2").End(xlDown))
            Sheets("Input Ref-No").Range("C12").Value = cell.Value
            '  run the mailer code(generate email) here
    Dim sh As Worksheet
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileName As String
    'Temporary path to save the PDF files
    'You can also use another folder like
    'TempFilePath = "C:\Users\Ron\MyFolder\"
    TempFilePath = Environ$("temp") & "\"
    'Loop through every worksheet
    Set sh = ActiveSheet
        FileName = ""
        'Test A1 for a mail address
        If sh.Range("a1").Value Like "?*@?*.?*" Then
            'If there is a mail address in A1 create the file name and the PDF
            TempFileName = TempFilePath & "Payslip - " & sh.Range("g13") & "'" & sh.Range("g14") & ".pdf"
            FileName = GVR_Create_PDF(Range("a2:h37"), TempFileName, True, False)

            'If publishing is OK create the mail
            If FileName <> "" Then
                GVR_Mail_PDF_Outlook FileName, sh.Range("A1").Value, "Salary Slip", _
                                     "Dear" & " " & sh.Range("D12") & vbNewLine & vbNewLine & "Please find the attached payslip for the month of " & sh.Range("g13") & "'" & sh.Range("g14") _
                                   & vbNewLine & vbNewLine & vbNewLine & vbNewLine & "GV Reddy", False
                'After the mail is created delete the PDF file in TempFilePath
                If Dir(TempFileName) <> "" Then Kill TempFileName
            Else
                MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                       "Microsoft Add-in is not installed" & vbNewLine & _
                       "The path to Save the file in arg 2 is not correct" & vbNewLine & _
                       "You didn't want to overwrite the existing PDF if it exist"
            End If
        End If
        Next cell
        End With
End Sub
 
Upvote 0
please see the below
Code:
Public Sub bulkemail_payslip()
Dim cell As Range
    
    With Sheets("Bulkmaillist")
        For Each cell In .Range("C2", .Range("C2").End(xlDown))
            Sheets("Input Ref-No").Range("C12").Value = cell.Value
            '  run the mailer code(generate email) here
    Dim sh As Worksheet
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileName As String
    'Temporary path to save the PDF files
    'You can also use another folder like
    'TempFilePath = "C:\Users\Ron\MyFolder\"
    TempFilePath = Environ$("temp") & "\"
    'Loop through every worksheet
    Set sh = ActiveSheet
        FileName = ""
        'Test A1 for a mail address
        If sh.Range("a1").Value Like "?*@?*.?*" Then
            'If there is a mail address in A1 create the file name and the PDF
            TempFileName = TempFilePath & "Payslip - " & sh.Range("g13") & "'" & sh.Range("g14") & ".pdf"
            FileName = GVR_Create_PDF(Range("a2:h37"), TempFileName, True, False)

            'If publishing is OK create the mail
            If FileName <> "" Then
                GVR_Mail_PDF_Outlook FileName, sh.Range("A1").Value, "Salary Slip", _
                                     "Dear" & " " & sh.Range("D12") & vbNewLine & vbNewLine & "Please find the attached payslip for the month of " & sh.Range("g13") & "'" & sh.Range("g14") _
                                   & vbNewLine & vbNewLine & vbNewLine & vbNewLine & "GV Reddy", False
                'After the mail is created delete the PDF file in TempFilePath
                If Dir(TempFileName) <> "" Then Kill TempFileName
            Else
                MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                       "Microsoft Add-in is not installed" & vbNewLine & _
                       "The path to Save the file in arg 2 is not correct" & vbNewLine & _
                       "You didn't want to overwrite the existing PDF if it exist"
            End If
        End If
        Next cell
        End With
End Sub
 
Upvote 0
Code:
Public Sub bulkemail_payslip()

    Dim cell As Range
    Dim sh As Worksheet
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileName As String
    
    'Set sh = ActiveSheet
    Set sh = Sheets("Input Ref-No") 'Better
    
    'Temporary path to save the PDF files
    'You can also use another folder like
    'TempFilePath = "C:\Users\Ron\MyFolder\"
    TempFilePath = Environ$("temp") & ""
    
    With Sheets("Bulkmaillist")
        For Each cell In .Range("C2", .Range("C2").End(xlDown))
            Sheets("Input Ref-No").Range("C12").Value = cell.Value
            
            '  run the mailer code(generate email) here
            FileName = ""
            'Test A1 for a mail address
            If sh.Range("a1").Value Like "?*@?*.?*" Then
                'If there is a mail address in A1 create the file name and the PDF
                TempFileName = TempFilePath & "Payslip - " & sh.Range("g13") & "'" & sh.Range("g14") & ".pdf"
                FileName = GVR_Create_PDF(sh.Range("a2:h37"), TempFileName, True, False)
    
                'If publishing is OK create the mail
                If FileName <> "" Then
                    GVR_Mail_PDF_Outlook FileName, sh.Range("A1").Value, "Salary Slip", _
                                         "Dear" & " " & sh.Range("D12") & vbNewLine & vbNewLine & _
                                         "Please find the attached payslip for the month of " & _
                                         sh.Range("g13") & "'" & sh.Range("g14") & _
                                         vbNewLine & vbNewLine & vbNewLine & vbNewLine & "GV Reddy", False
                    'After the mail is created delete the PDF file in TempFilePath
                    If Dir(TempFileName) <> "" Then Kill TempFileName
                Else
                    MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                           "Microsoft Add-in is not installed" & vbNewLine & _
                           "The path to Save the file in arg 2 is not correct" & vbNewLine & _
                           "You didn't want to overwrite the existing PDF if it exist"
                End If
            End If
            
        Next cell
    End With
    
End Sub
 
Upvote 0
Hi,

Thank you so much for your reply,

It's not working, am coping the function module also for your reference, dont know the reason why its not happening

Code:
Sub PayslipHeads_Rectangle10_Click()
Sheets("Payslip").Visible = True
End Sub
Option Explicit
'The code below are used by the macros in the other two modules
'Do not change the code in the functions in this module
Function GVR_Create_PDF(Myvar As Object, FixedFilePathName As String, _
                        OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim Fname As Variant
    'Test If the Microsoft Add-in is installed
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
        If FixedFilePathName = "" Then
            'Open the GetSaveAsFilename dialog to enter a file name for the pdf
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
                                                  Title:="Create PDF")
            'If you cancel this dialog Exit the function
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If
        'If OverwriteIfFileExist = False we test if the PDF
        'already exist in the folder and Exit the function if that is True
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If
        'Now the file name is correct we Publish to PDF
        On Error Resume Next
        Myvar.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0
        'If Publish is Ok the function will return the file name
        If Dir(Fname) <> "" Then GVR_Create_PDF = Fname
    End If
End Function
 
Function GVR_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
                              StrSubject As String, StrBody As String, Send As Boolean)
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = StrTo
        .CC = ""
        .BCC = ""
        .Subject = StrSubject
        .Body = StrBody
        .Attachments.Add FileNamePDF
        If Send = True Then
            .Send
        Else
            .Display
        End If
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Function
 
Function Create_PDF_Sheet_Level_Names(NamedRange As String, FixedFilePathName As String, _
                                      OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
'This function will create a PDF with every sheet with
'a sheet level name variable <NamedRange> in it
    Dim FileFormatstr As String
    Dim Fname As Variant
    Dim Ash As Worksheet
    Dim sh As Worksheet
    Dim ShArr() As String
    Dim s As Long
    Dim SheetLevelName As Name
    'Test If the Microsoft Add-in is installed
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
        'We fill the Array with sheets with the sheet level name variable
        For Each sh In ActiveWorkbook.Worksheets
            If sh.Visible = -1 Then
                Set SheetLevelName = Nothing
                On Error Resume Next
                Set SheetLevelName = sh.Names(NamedRange)
                On Error GoTo 0
                If Not SheetLevelName Is Nothing Then
                    s = s + 1
                    ReDim Preserve ShArr(1 To s)
                    ShArr(s) = sh.Name
                End If
            End If
        Next sh
        'We exit the function If there are no sheets with
        'a sheet level name variable named <NamedRange>
        If s = 0 Then Exit Function
        If FixedFilePathName = "" Then
            'Open the GetSaveAsFilename dialog to enter a file name for the pdf
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
                                                  Title:="Create PDF")
            'If you cancel this dialog Exit the function
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If

        'If OverwriteIfFileExist = False we test if the PDF
        'already exist in the folder and Exit the function if that is True
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        'Remember the ActiveSheet
        Set Ash = ActiveSheet
        'Select the sheets with the sheet level name in it
        Sheets(ShArr).Select
        'Now the file name is correct we Publish to PDF
        On Error Resume Next
        ActiveSheet.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0
        'If Publish is Ok the function will return the file name
        If Dir(Fname) <> "" Then
            Create_PDF_Sheet_Level_Names = Fname
        End If
        Ash.Select
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If
End Function
Sub Payslip_Picture2_2_Click()
Dim cell As Range
    Dim sh As Worksheet
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileName As String
    
    'Set sh = ActiveSheet
    Set sh = Sheets("Input Ref-No") 'Better
    
    'Temporary path to save the PDF files
    'You can also use another folder like
    'TempFilePath = "C:\Users\Ron\MyFolder\"
    TempFilePath = Environ$("temp") & ""
    
    With Sheets("Bulkmaillist")
        For Each cell In .Range("C2", .Range("C2").End(xlDown))
            Sheets("Input Ref-No").Range("C12").Value = cell.Value
            
            '  run the mailer code(generate email) here
            FileName = ""
            'Test A1 for a mail address
            If sh.Range("a1").Value Like "?*@?*.?*" Then
                'If there is a mail address in A1 create the file name and the PDF
                TempFileName = TempFilePath & "Payslip - " & sh.Range("g13") & "'" & sh.Range("g14") & ".pdf"
                FileName = GVR_Create_PDF(sh.Range("a2:h37"), TempFileName, True, False)
    
                'If publishing is OK create the mail
                If FileName <> "" Then
                    GVR_Mail_PDF_Outlook FileName, sh.Range("A1").Value, "Salary Slip", _
                                         "Dear" & " " & sh.Range("D12") & vbNewLine & vbNewLine & _
                                         "Please find the attached payslip for the month of " & _
                                         sh.Range("g13") & "'" & sh.Range("g14") & _
                                         vbNewLine & vbNewLine & vbNewLine & vbNewLine & "GV Reddy", False
                    'After the mail is created delete the PDF file in TempFilePath
                    If Dir(TempFileName) <> "" Then Kill TempFileName
                Else
                    MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                           "Microsoft Add-in is not installed" & vbNewLine & _
                           "The path to Save the file in arg 2 is not correct" & vbNewLine & _
                           "You didn't want to overwrite the existing PDF if it exist"
                End If
            End If
            
        Next cell
    End With

End Sub
 
Upvote 0
Hi,

I also tried calling macro, Inside the macro which you have sent, but it was also not working..when i call that individually it works, but when i use this like below its not working..

Code:
Public Sub Bulkemail_payslip()
 Dim cell As Range
    
    With Sheets("Bulkmaillist")
        For Each cell In .Range("C2", .Range("C2").End(xlDown))
            Sheets("Input Ref-No").Range("C12").Value = cell.Value
            '  run the mailer code(generate email) here
                Call payslip_pdf
        Next cell
    End With
End Sub
 
Upvote 0
As a test, run this macro. It should display one-at-a-time each item in Bulkmaillist column C. Does it do that?

Code:
Sub Test_list()
 Dim cell As Range
    
    With Sheets("Bulkmaillist")
        For Each cell In .Range("C2", .Range("C2").End(xlDown))
                MsgBox cell.Value
        Next cell
    End With
End Sub
 
Upvote 0
Hi,

Your testing code is working fine, i want the same, but i want to call the macro there instead of message box, can you please help me where am i going wrong.

Regards,
GV Reddy
 
Upvote 0
Does this display the correct values from Input Ref-No cell A1 ?

Code:
Sub Test_list2()
 Dim cell As Range
    
    With Sheets("Bulkmaillist")
        For Each cell In .Range("C2", .Range("C2").End(xlDown))
            Sheets("Input Ref-No").Range("C12").Value = cell.Value
            '  run the mailer code(generate email) here
            ' Call payslip_pdf
            MsgBox Sheets("Input Ref-No").Range("A1")
        Next cell
    End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,218
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top