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

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
 
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
    With Sheets("Sheet1").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2:A" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("E2:E" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("F2:F" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:J" & lRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    v = Range("A2:A" & lRow).Resize(, 11).Value
    Set OutApp = CreateObject("Outlook.Application")
    With CreateObject("scripting.dictionary")
        For i = LBound(v) To UBound(v)
            If v(i, 11) <> "yes" Then
                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("A1:G" & lRow).SpecialCells(xlCellTypeVisible)
                        Set OutMail = OutApp.CreateItem(0)
                        With OutMail
                            .To = rName.Offset(, 21)
                            .cc = rName.Offset(, 22)
                            .Subject = "Weekly Work Issue" & "-" & v(i, 5) & "-" & v(i, 1)
                                .HTMLBody = "<p>Hi " & v(i, 1) & "," & "<br><br>" & "Please see below an overview of your work Tuesday to Friday.  Your final schedule will be emailed to you the day before the appointments are due to take place." & "<br><br>" & v(i, 10) & "<br>" & 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
            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
Hi good afternoon this is working great the only thing its missing is a table around all the data sent, and also this line below if this can be added back in please?
VBA Code:
MsgStr = "<p>Hi " & cell.Offset(0, -8).Value & "," & vbNewLine & "please see below an overview of your work Tuesday to Friday.  Your final schedule will be emailed to you the day before the appointments are due to take place." & "<br><br>" & vbNewLine & cell.Offset(0, 1).Value & "<br><br>" _
 
Upvote 0

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Insert this line of code:
VBA Code:
Range("A2", Range("G" & Rows.Count).End(xlUp)).Borders.LineStyle = xlContinuous
directly above this line:
VBA Code:
v = Range("A2:A" & lRow).Resize(, 11).Value

MsgStr = "<p>Hi " & cell.Offset(0, -8).Value & "," & vbNewLine & "please see below an overview of your work Tuesday to Friday. Your final schedule will be emailed to you the day before the appointments are due to take place." & "<br><br>" & vbNewLine & cell.Offset(0, 1).Value & "<br><br>" _
This code is already in the macro.
 
Upvote 0
Insert this line of code:
VBA Code:
Range("A2", Range("G" & Rows.Count).End(xlUp)).Borders.LineStyle = xlContinuous
directly above this line:
VBA Code:
v = Range("A2:A" & lRow).Resize(, 11).Value


This code is already in the macro.
It didn’t work for some reason. And the data wasn’t in a border hope you can help please
 
Upvote 0
It worked for me. Here is a sample of what I got. Please note the lines in red and the borders.

Hi Andrew Best,

Please see below an overview of your work Tuesday to Friday. Your final schedule will be emailed to you the day before the appointments are due to take place.


Operative Name​
MPAN​
P/Code​
Job Type Description​
Date​
T/Band​
Additional Information​
Andrew Best365236testEnergise2023-04-0312:00-16:00ring door
Andrew Best255466testDe-energise2023-04-0312:00-16:00n/a
 
Upvote 0
It worked for me. Here is a sample of what I got. Please note the lines in red and the borders.

Hi Andrew Best,

Please see below an overview of your work Tuesday to Friday. Your final schedule will be emailed to you the day before the appointments are due to take place.



Operative Name​
MPAN​
P/Code​
Job Type Description​
Date​
T/Band​
Additional Information​
Andrew Best365236testEnergise2023-04-0312:00-16:00ring door
Andrew Best255466testDe-energise2023-04-0312:00-16:00n/a
Oww ok I will have another look at it thank you
 
Upvote 0
Oww ok I will have another look at it thank you
Hi good afternoon i still don't get the border around all of it unfortunately, please see below. Please is there any chance to add this message box in as well before the emails are sent? if these 2 things can be added then this will be perfect and thankyou so much for your help.
VBA Code:
Dim answer As Integer
  answer = MsgBox("Do you want to continue?", vbQuestion + vbYesNo)

  If answer = vbNo Then Exit Sub
Untitled.png
 
Upvote 0
Hi good afternoon i still don't get the border around all of it unfortunately, please see below. Please is there any chance to add this message box in as well before the emails are sent? if these 2 things can be added then this will be perfect and thankyou so much for your help.
VBA Code:
Dim answer As Integer
  answer = MsgBox("Do you want to continue?", vbQuestion + vbYesNo)

  If answer = vbNo Then Exit Sub
View attachment 88406
If possible please can you put this bit of code back in please, what this does is look at 'Email Links' row Y and if theres is any 'notes' that needs to be added to the email it adds them to the relevant person in the email
Code:
lr = Cells(Rows.Count, "A").End(xlUp).Row

With Range("J2:J" & lr)

    .Formula = "=XLOOKUP(A2,'Email Links'!A:A,'Email Links'!Y:Y)"

    .Value = .Value

End With
 
Upvote 0
As I mentioned before, the macro adds the borders properly for me. See below:

Hi Andrew Best,

Please see below an overview of your work Tuesday to Friday. Your final schedule will be emailed to you the day before the appointments are due to take place.


Operative Name​
MPAN​
P/Code​
Job Type Description​
Date​
T/Band​
Additional Information​
Notes​
Andrew Best365236testEnergise2023-04-0312:00-16:00ring doorNote5
Andrew Best255466testDe-energise2023-04-0312:00-16:00n/aNote5

add this message box in as well before the emails are sent
Do you want this message to appear before each individual email is sent? If so, this means that if there are 20 emails, the message would appear 20 times. Please clarify.
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,172
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