Macro to insert "File already selected"

[howard]

I have file names in Col A for eg Sales BR1.xlsm


I have a macro which lets the user select a file and then to attach it to an email. If the file selected matched the file name in Col A., I would like code to insert in Col C in the same row as Col A "file already selected"


My code is

 Sub SendFiles()
Dim lCount As Long, sht As Worksheet, vFilenames, sPath$, lFilecount As Long, sFullName$
 sPath = "C:\Summary Sales Reports\"     ' your path here

ChDrive sPath
ChDir sPath
wn = ThisWorkbook.Name
vFilenames = Application.GetOpenFilename("Microsoft Excel files (*.xls),*.xlsx", , "Select the file(s) to open", , True)
If TypeName(vFilenames) = "Boolean" Then Exit Sub
For lCount = LBound(vFilenames) To UBound(vFilenames)
    Workbooks.Open vFilenames(lCount), UpdateLinks:=False
    Application.CutCopyMode = False
    Sheets(Array("summary")).Copy
    ActiveWorkbook.SaveAs Replace(vFilenames(lCount), ".xlsx", "") & "_summary.xls", FileFormat:=xlNormal
    vFilenames(lCount) = ActiveWorkbook.FullName
    For Each sht In Sheets(Array("summary"))
        Sheets(sht.Name).UsedRange.Copy
        Sheets(sht.Name).[a1].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next
    ActiveWorkbook.Close True
    Application.DisplayAlerts = True
    Application.CutCopyMode = True
Next
 Mailfiles "dave.martins@sdtm.com", vFilenames
 ActiveWorkbook.Close True
 'Kill vFilenames(lCount)
End Sub


Sub Mailfiles(mail_ad$, vFiles)
Dim oMailItem As Object, oOLapp As Object, lCt&, r As Range, sh As Worksheet
'Set oOLapp = CreateObject("Outlook.application")
Set oOLapp = GetObject(, "Outlook.application")                                 ' assumes Outlook is open
Set oMailItem = oOLapp.CreateItem(0)
With oMailItem
    .To = mail_ad
      .Subject = Application.ActiveWorkbook.Name & "  -Sales Report"
         
    .Display
    Set sh = Workbooks(wn).Sheets("sheet1")                                     ' where the CC list is
'    MsgBox "This workbook: " & wn & vbLf & "Active: " & ActiveWorkbook.FullName
    Set r = sh.[a:a].Find(ActiveWorkbook.Name, sh.[a1], xlValues, xlPart)
    If Not r Is Nothing Then .cc = CStr(r.Offset(, 1).Value)
  
    
    .body = "Attached please find Sales figures as as at  " & Format(Application.EoMonth(Date, -1), _
    "mmm yyyy") & " vs the Prior Year" & vbNewLine & vbNewLine
      
    
    
    .body = .body & "Regards" & vbNewLine & vbNewLine & "Damaon"
    For lCt = LBound(vFiles) To UBound(vFiles)
        .Attachments.Add CStr(vFiles(lCt))
    Next
    Set oOLapp = Nothing
    Set oMailItem = Nothing
End With
End Sub

It would be appreciated if someone would be able to assist me to add the line of code to insert the text "File already selected"

 

[PatOBrien198]

Dim rngFound As Range

For lCount = LBound(vFilenames) To UBound(vFilenames)

    Set rngFound = Range("A:A").Find(What:=vFilenames(lCount), LookIn:=xlValues, lookat:=xlWhole)
    If (Not rngFound Is Nothing) Then rngFound.Offset(0, 2) = "File already selected"

'...

 

[howard]

Thanks for the help, much appreciated