Macro sending e-mail to one or more consignees

JOJESS

New Member
Joined
Dec 8, 2017
Messages
1
Hi all,

I have a pivot table. Below is a snap picture from it. What I need, is an e-mail to be sent if a unique date (for instance 2017-12-12) have more than two equal times (for instance 13:45).

If not possible, I would at least need to have a color indicator that highlights those rows.

Thanks for the ones having this knowledge and sharing it.

KR Jessica

__________________________________________
2017-12-12N/AB066325C
2017-12-121345B068160A
2017-12-121345B068391A
2017-12-121345B068160B
2017-12-12745B068268BG
2017-12-12745B068268CG

<tbody>
</tbody><colgroup><col><col><col></colgroup>
2017-12-12 N/AB066325C
2017-12-121345B068160A
2017-12-121345B068391A
2017-12-121345B068160B
2017-12-12745B068268BG
2017-12-12745B068268CG





<tbody>
</tbody><colgroup><col><col><col></colgroup>
 

Some videos you may like

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
3,849
.
Here's one way:

Code:
Option Explicit
Sub Macro1()
     
    Const lngStartRow As Long = 1 'Starting Row number for the data. Change to suit.
    Const strStartCol As String = "B" 'Starting column letter for the duplicates. Change to suit.
     
    Dim lngLastCol    As Long
    Dim lngMyCol      As Long
    Dim lngLastRow    As Long
    Dim lngMyRow      As Long
    Dim strMyCol      As String
    Dim strPK         As String 'Primary Key
    Dim xlnCalcMethod As XlCalculation
     
    Application.ScreenUpdating = False
         
     'Note the sheet must have data in it or the next lines will error out!!
    lngLastCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
     
     'Remove any previous duplicate highlighting
    strMyCol = Left(Cells(1, lngLastCol).Address(True, False), Application.WorksheetFunction.Search("$", Cells(1, lngLastCol).Address(True, False)) - 1)
    Range(Cells(lngStartRow, strStartCol), Cells(lngLastRow, strMyCol)).Interior.Color = xlNone
     
     'Create Primary Key formula
    For lngMyCol = Asc(strStartCol) - 64 To lngLastCol
        strMyCol = Left(Cells(1, lngMyCol).Address(True, False), Application.WorksheetFunction.Search("$", Cells(1, lngMyCol).Address(True, False)) - 1)
        If lngMyCol = Asc(strStartCol) - 64 Then
            strPK = "=" & strMyCol & lngStartRow
        Else
            strPK = strPK & "&" & strMyCol & lngStartRow
        End If
    Next lngMyCol
     
    strMyCol = Left(Cells(1, lngLastCol + 1).Address(True, False), Application.WorksheetFunction.Search("$", Cells(1, lngLastCol + 1).Address(True, False)) - 1)
     
     'Copy Primary Key formula down dataset
    Range(Cells(lngStartRow, strMyCol), Cells(lngLastRow, strMyCol)).Formula = strPK
     
     'Loop through Primary Key field and highlight duplicates
    For lngMyRow = lngStartRow To lngLastRow
        If Evaluate("COUNTIF(" & Range(strMyCol & lngStartRow & ":" & strMyCol & lngStartRow & lngLastRow).Address(True, True) & "," & Range(strMyCol & lngMyRow).Address(False, True) & ")") > 1 Then
           Range(Cells(lngMyRow, Asc(strStartCol) - 64), Cells(lngMyRow, lngLastCol)).Interior.Color = RGB(255, 255, 0) 'Highlight duplicates in yellow. Change to suit.
        End If
    Next lngMyRow
        
    'Delete helper column
    Columns(strMyCol).EntireColumn.Delete
     
     
    Application.ScreenUpdating = True
         
  
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,481
Messages
5,596,391
Members
414,063
Latest member
N_Bates

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
Top