If name not found msgbox states the name which is not found

P

Patriot2879

Well-known Member
Joined
Feb 1, 2018
Messages
1,227
Office Version
  1. 2010
Platform
  1. Windows
Hi All happy Friday, I hope you can help me please - i have a snippet of code below where the Range is A2 to last row and under 'Email Links row V to find the matching name. This works great, but i would like to add a message box that if the name is not found in A2 to last row then a message box will pop up stating 'Jo Bloggs' not found! - for example, then asks a yes or no if i want to continue and it will skip that name not found. Can you help please and i hope this makes sense.
VBA Code: 
   Dim Cl As Range
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      Cl.Value = Trim(Cl.Value)
   Next Cl
  
Dim lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
With Range("I2:I" & lr)
    .Formula = "=XLOOKUP(A2,'Email Links'!A:A,'Email Links'!V:V)"
    .Value = .Value
End With
 
Sort by date Sort by votes
mumps said:
This code is working properly for me in the last file you uploaded:
VBA Code: 
Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, rng As Range, v As Variant, i As Long, lRow As Long, rName As Range
    lRow = Cells(Rows.Count, "A").End(xlUp).Row
    v = Range("A2:A" & lRow).Value
    Set OutApp = CreateObject("Outlook.Application")
    With CreateObject("scripting.dictionary")
        For i = LBound(v) To UBound(v)
            Set rName = Sheets("Email Links").Range("A:A").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
            If Not rName Is Nothing Then
                If Not .exists(v(i, 1)) Then
                    .Add v(i, 1), Nothing
                    Range("A1").CurrentRegion.AutoFilter 1, v(i, 1)
                    'fVisRow = Rows("2:" & lRow).SpecialCells(xlCellTypeVisible).Row
                    Set rng = Range("A2:G" & lRow).SpecialCells(xlCellTypeVisible)
                    Set OutMail = OutApp.CreateItem(0)
                    With OutMail
                        .To = rName.Offset(, 21)
                        .cc = rName.Offset(, 22)
                        .Subject = ""
                        .HTMLBody = RangetoHTML(rng)
                        .Display
                    End With
                End If
            End If
        Next i
    End With
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", "align=left x:publishsource=")
    TempWB.Close savechanges:=False
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
Are you using a PC or a Mac?
Click to expand...
Very odd I am using a PC
 
Upvote 0

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Click here to download your file. It is working properly for me.
 
Upvote 0
mumps said:
Click here to download your file. It is working properly for me.
Click to expand...
Good morning, thank you for the file, it kind of works for me it sends all the emails and misses out the names not found, but i dont get a message box pop up saying which name or names not found and if i want to continue or not
 
Upvote 0
Try:
VBA Code: 
Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim OutApp As Object, OutMail As Object, rng As Range, v As Variant, i As Long, lRow As Long, rName As Range
    lRow = Cells(Rows.Count, "A").End(xlUp).Row
    v = Range("A2:A" & lRow).Value
    Set OutApp = CreateObject("Outlook.Application")
    With CreateObject("scripting.dictionary")
        For i = LBound(v) To UBound(v)
            Set rName = Sheets("Email Links").Range("A:A").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
            If Not rName Is Nothing Then
                If Not .exists(v(i, 1)) Then
                    .Add v(i, 1), Nothing
                    Range("A1").CurrentRegion.AutoFilter 1, v(i, 1)
                    Set rng = Range("A2:G" & lRow).SpecialCells(xlCellTypeVisible)
                    Set OutMail = OutApp.CreateItem(0)
                    With OutMail
                        .To = rName.Offset(, 21)
                        .cc = rName.Offset(, 22)
                        .Subject = ""
                        .HTMLBody = RangetoHTML(rng)
                        .Display
                    End With
                End If
            Else
                If MsgBox(v(i, 1) & " was not found. Do you wish to continue?", vbYesNo) = vbNo Then
                    Range("A1").AutoFilter
                    Exit Sub
                End If
            End If
        Next i
    End With
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", "align=left x:publishsource=")
    TempWB.Close savechanges:=False
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
 
Upvote 0
Hi good morning thank you for this, this works but it freezes when i click on yes or no. Can it be adjusted to if i click on yes it goes to the next name and if i click on no it aborts?
 
Upvote 0
Patriot2879 said:
Can it be adjusted to if i click on yes it goes to the next name and if i click on no it aborts?
Click to expand...
The code as written, already does this.
VBA Code: 
If MsgBox(v(i, 1) & " was not found. Do you wish to continue?", vbYesNo) = vbNo Then
                    Range("A1").AutoFilter
                    Exit Sub
                End If
 
Upvote 0
mumps said:
The code as written, already does this.
VBA Code: 
If MsgBox(v(i, 1) & " was not found. Do you wish to continue?", vbYesNo) = vbNo Then
                    Range("A1").AutoFilter
                    Exit Sub
                End If
Click to expand...
Ok thank you for some reason it freezes for a few minutes when I click on yes and
It won’t let me click on no
 
Upvote 0
The macro works properly when I tested it. Are you using the macro on the file you uploaded or on a different file? If on a different file, please upload a copy of the file that is not working for you.
 
Upvote 0
mumps said:
The macro works properly when I tested it. Are you using the macro on the file you uploaded or on a different file? If on a different file, please upload a copy of the file that is not working for you.
Click to expand...
It seems to be working now thank you very much, is there any way I can put the code into my original code so it does everything else as well like border around the work, subject, and notes in the body of email?
 
Upvote 0
Patriot2879 said:
put the code into my original code so it does everything else as well like border around the work, subject, and notes in the body of email?
Click to expand...
Could you use code tags to post your original code and explain in detail what else you want the macro to do referring to specific cells, rows, columns and sheets,
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
Excel 365 Compare Date & Copy Cell Data for Data Base
2 3 4
Replies
33
Views
760
skillilea
S
JohnPoole
  • Solved
Delete rows based on unique values
2
Replies
17
Views
880
kevin9999
K
J
  • Solved
VBA to compare rows in two different sheets, if match highlight cell
2
Replies
10
Views
636
kevin9999
K
N
  • Solved
Move entire row based on expiration date
2
Replies
17
Views
219
rollis13
rollis13
H
  • Solved
Macro to display message end of Code where Col D contains blanks
Replies
7
Views
338
howard
H

Forum statistics

Threads
1,215,006
Messages
6,122,666
Members
449,091
Latest member
peppernaut

Share this page

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