none
Vlookup in VBA RRS feed

  • Question

  • VBA novice here, but excited to learn! And I am working with the below code that is working just the way I want, but I am trying to incorporate some vlookups codes for functions that will return a specific Subject and Body from a spreadsheet. Does anyone have any ideas? Can I provide any further info to help? I can send the spreadsheet to someone, if it helps. Thanks!

    
    Sub Send_Row_Or_Rows_1()
    'As of 7.13.16
        Dim OutApp As Object
        Dim OutMail As Object
        Dim sh As Worksheet
        Dim cell As Range
        Dim FileCell As Range
        Dim rng As Range
    
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
    
        Set sh = Sheets("MailInfo")
    
        Set OutApp = CreateObject("Outlook.Application")
    
        For Each cell In sh.Columns("C").Cells.SpecialCells(xlCellTypeConstants)
    
                                  
            'Enter the path/file names in the G:J column in each row
            Set rng = sh.Cells(cell.Row, 1).Range("G1:J1")
    
            If cell.Value Like "?*@?*.?*" And _
               Application.WorksheetFunction.CountA(rng) > 0 Then
                Set OutMail = OutApp.CreateItem(0)
    
                With OutMail
                    .Importance = 2 '0 = Low, 2 = High, 1 = Normal
                    .ReadReceiptRequested = True 'or False
                    .OriginatorDeliveryReportRequested = True 'or False
                    .SentOnBehalfOfName = "tribal@ee.doe.gov"
                    .to = cell.Value
                    .CC = "tribal@ee.doe.gov, " '& mailAddress2
                    .BCC = "tribal@ee.doe.gov"
                    .Subject = Subject 'or use .Subject = "Subject"
                    .Body = Message 'or use .Body = "Enter Text Here " & cell.Offset(0, -1).Value
    
                    For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                        If Trim(FileCell) <> "" Then
                            If Dir(FileCell.Value) <> "" Then
                                .Attachments.Add FileCell.Value
                            End If
                        End If
                    Next FileCell
    
                    .Display  'Or use .Send
                End With
    
                Set OutMail = Nothing
            End If
        Next cell
    
        Set OutApp = Nothing
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End Sub
    
    

    Wednesday, July 13, 2016 9:58 PM

Answers

  • Hi, Kris

     

    >>The code is correctly creating emails and then inserting the appropriate attachments from my worksheet, and including the necessary hardcoded data, and finally the correct "To" email from column B. I want each email created to also then be able to pull the correct Subject and Body (columns E and F).

    >>I believe I will need a Vlookup to key off of the data in column B

     

    What do you mean "key off of the data in column B"?

    Since we don’t get your screenshot of your table, we can only make a hypothesis of what you want, according to your code.

     

    For the piece of code below, what you are doing is to search column B, if the cells are constant, get the range from column G to J at the same row of the cell which we find in column B. Meaning if B1 is a constant, rng="G1:J1" and if B2 is a constant, rng="G2:J2".

        For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        Set rng = sh.Cells(cell.Row, 1).Range("G1:J1")
        Next cell


     

    About pulling the correct Subject and Body (columns E and F), do you mean get the value in column E and F corresponding  the data in column B?


    Sub test()
        Dim sh As Worksheet
        Dim cell As Range
        Dim rng As Range
        Dim sbj, bdy As Variant
        Set sh = Sheets("Sheet1")
        For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        Set rng = sh.Cells(cell.Row, 1).Range("G1:J1")
        sbj = Application.VLookup(cell, Sheet1.Range("B1:J7"), 4, False)
        bdy = Application.VLookup(cell, Sheet1.Range("B1:J7"), 5, False)
        Debug.Print sbj; bdy
        Next cell
    End Sub





    Thursday, July 21, 2016 3:35 AM
    Moderator

All replies

  • Hi CO,

    >>incorporate some vlookups codes for functions that will return a specific Subject and Body from a spreadsheet

    See WorksheetFunction.VLookup Method (Excel)

    You can refer to the sample code below.

    Sub test()
    Dim a, b As Variant
    a = Sheet1.Range("C1").Value 
    b = Application.VLookup(a, Sheet1.Range("A1:B10"), 2, False)
    If Application.WorksheetFunction.IsError(b) Then
    MsgBox ("Cannot find")
    Else
    Debug.Print b
    End If
    End Sub

    Best Regards,

    Edward


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.


    Thursday, July 14, 2016 6:41 AM
  • Edward,

    Hello, and thank you so much for taking the time. I took your advice, and have done much more research online, but I have not been successful. I am likely in over my head, but I will struggle on.

    Below is the code I have, which does not include any of the attempts to code to include VLOOKUP functions. My range is A4:J6 (for testing), and the Subject and Body functions I am trying to incorporate are in columns E and F respectively. Any pointers?

    Sub Send_Row_Or_Rows_1()
    'As of 7.13.16
    'Excel 2000-2016
        Dim OutApp As Object
        Dim OutMail As Object
        Dim sh As Worksheet
        Dim cell As Range
        Dim FileCell As Range
        Dim rng As Range
    
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
    
        Set sh = Sheets("MailInfo")
    
        Set OutApp = CreateObject("Outlook.Application")
    
        For Each cell In sh.Columns("C").Cells.SpecialCells(xlCellTypeConstants)
    
                                  
            'Enter the path/file names in the G:J column in each row
            Set rng = sh.Cells(cell.Row, 1).Range("G1:J1")
    
            If cell.Value Like "?*@?*.?*" And _
               Application.WorksheetFunction.CountA(rng) > 0 Then
                Set OutMail = OutApp.CreateItem(0)
    
                With OutMail
                    .Importance = 2 '0 = Low, 2 = High, 1 = Normal
                    .ReadReceiptRequested = True 'or False
                    .OriginatorDeliveryReportRequested = True 'or False
                    .SentOnBehalfOfName = "sentfrom@test.com"
                    .to = cell.Value
                    .CC = "cc@test.com, " '& mailAddress2
                    .BCC = "bcc@test.com"
                    .Subject = Subject 'or use .Subject = "Subject"
                    .Body = Message 'or use .Body = "Enter Text Here " & cell.Offset(0, -1).Value
    
                    For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                        If Trim(FileCell) <> "" Then
                            If Dir(FileCell.Value) <> "" Then
                                .Attachments.Add FileCell.Value
                            End If
                        End If
                    Next FileCell
    
                    .Display  'Or use .Send
                End With
    
                Set OutMail = Nothing
            End If
        Next cell

    Tuesday, July 19, 2016 3:37 PM
  • Hi,

    >>My range is A4:J6 (for testing), and the Subject and Body functions I am trying to incorporate are in columns E and F respectively

     

    Refer to WorksheetFunction.VLookup Method (Excel), expression .VLookup(Arg1, Arg2, Arg3, Arg4), it searches Arg1 in the first column of Arg2. In your case, if you set Arg2(range) to A4:J6, you are searching Arg1 in the A4:A6. If it is found, it will return the value in the columnX . X depends on Arg3. Lets assume it found Arg1 in the A5, if Arg3=1, it returns the value of A5 while if Arg3=2, it returns the value of B5.

     

    According to your description, do you mean that you want to search some specific value in A4:A6, and  then returns the value in the columns E and F and passes them to Subject/Body?

    What's the specific value you want to search and what do you want to get? I suggest you share more concrete information about your requirement. A screenshot might be helpful for us to figure out your need. An updated simple code below. I am searching the value of A1 in A4:J6 and return the value in the columns E if it is found.

     

    Sub test()
    Dim a, subject As Variant
    a = Sheet1.Range("A1").Value  'set the value you want to search 
    subject = Application.VLookup(a, Sheet1.Range("A4:J6"), 5, False) 'Col_index_num=5 because Subject is in column E
    If Application.WorksheetFunction.IsError(subject) Then
    MsgBox ("Cannot find")
    Else
    MsgBox (subject)
    End If
    End Sub



    Wednesday, July 20, 2016 9:32 AM
    Moderator
  • Hibari,

    Thanks for your time, and helping me to think this all out. My root problem seems to be my lack of understanding about the current code I am working with. The code is correctly creating emails and then inserting the appropriate attachments from my worksheet, and including the necessary hardcoded data, and finally the correct "To" email from column B. I want each email created to also then be able to pull the correct Subject and Body (columns E and F). I eventually want to pull columns C and D, too, but I hope to be able to do that on my own after getting help with the Subject and Body sections.

    So, I believe I will need a Vlookup to key off of the data in column B, which the below code is transforming into "cell.value" or maybe "sh.Columns"?

    The most up-to-date version of the code is below (I made a small tweak), and also a screenshot of the table that I am working with.

    I apologize if I am still not being clear. I purchased Excel 2013 Power Programming with VBA recently, but have been struggling through it. But I have enjoyed the struggle.

    Sub Send_Row_Or_Rows_1()
    'As of 7.20.16
    'Excel 2000-2016
        Dim OutApp As Object
        Dim OutMail As Object
        Dim sh As Worksheet
        Dim cell As Range
        Dim FileCell As Range
        Dim rng As Range
                
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
    
        Set sh = Sheets("MailInfo")
    
        Set OutApp = CreateObject("Outlook.Application")
    
        For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
    
                                  
            'Enter the path/file names in the G:J column in each row
            Set rng = sh.Cells(cell.Row, 1).Range("G1:J1")
    
            If cell.Value Like "?*@?*.?*" And _
               Application.WorksheetFunction.CountA(rng) > 0 Then
                Set OutMail = OutApp.CreateItem(0)
    
                With OutMail
                    .Importance = 2 '0 = Low, 2 = High, 1 = Normal
                    .ReadReceiptRequested = True 'or False
                    .OriginatorDeliveryReportRequested = True 'or False
                    .SentOnBehalfOfName = "sentfrom@test.com"
                    .to = cell.Value
                    .CC = "cc@test.com, " '& mailAddress2
                    .BCC = "bcc@test.com"
                    .subject = subject 'or use .Subject = "Subject"
                    .Body = Message 'or use .Body = "Enter Text Here " & cell.Offset(0, -1).Value
    
                    For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                        If Trim(FileCell) <> "" Then
                            If Dir(FileCell.Value) <> "" Then
                                .Attachments.Add FileCell.Value
                            End If
                        End If
                        
            
                    Next FileCell
    
                    .Display  'Or use .Send
                End With
    
                Set OutMail = Nothing
            End If
        Next cell
    
        Set OutApp = Nothing
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End Sub
    
    

    
    Wednesday, July 20, 2016 4:31 PM
  • Hi, Kris

     

    >>The code is correctly creating emails and then inserting the appropriate attachments from my worksheet, and including the necessary hardcoded data, and finally the correct "To" email from column B. I want each email created to also then be able to pull the correct Subject and Body (columns E and F).

    >>I believe I will need a Vlookup to key off of the data in column B

     

    What do you mean "key off of the data in column B"?

    Since we don’t get your screenshot of your table, we can only make a hypothesis of what you want, according to your code.

     

    For the piece of code below, what you are doing is to search column B, if the cells are constant, get the range from column G to J at the same row of the cell which we find in column B. Meaning if B1 is a constant, rng="G1:J1" and if B2 is a constant, rng="G2:J2".

        For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        Set rng = sh.Cells(cell.Row, 1).Range("G1:J1")
        Next cell


     

    About pulling the correct Subject and Body (columns E and F), do you mean get the value in column E and F corresponding  the data in column B?


    Sub test()
        Dim sh As Worksheet
        Dim cell As Range
        Dim rng As Range
        Dim sbj, bdy As Variant
        Set sh = Sheets("Sheet1")
        For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        Set rng = sh.Cells(cell.Row, 1).Range("G1:J1")
        sbj = Application.VLookup(cell, Sheet1.Range("B1:J7"), 4, False)
        bdy = Application.VLookup(cell, Sheet1.Range("B1:J7"), 5, False)
        Debug.Print sbj; bdy
        Next cell
    End Sub





    Thursday, July 21, 2016 3:35 AM
    Moderator