• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to select unique records from both the sheets

ThrottleWorks

ThrottleWorks

Excel Ninja
Hi,

Kindly refer attached excel file for problem details.

Please not that my motive is not to have ready answers, kindly give a suggestion or direction about how should I proceed.

I have details in two different tabs of same file.
In the attached file 1 and 2 (sheet name).

I need to check Column B and C in both the tabs.

Derive data based on the conditions.


We will take example from attached file only.

Filter on Yamaha that is value in cell B2 of sheet 1.

Then check if the same value which is Yamaha is present in Sheet 2 also.

Filtered on Sheet 2 with Yamaha, I have only one record. That is range A2:D2.

And from the sheet 1 I have range as A2:D3.


I will copy both these ranges as paste in sheet 4.

See range B3 and B8 ‘Present in Both Sheet 1 and Sheet 2’

In sheet 1 filter on KTM, this is present in Sheet 1 only. Not present in sheet 2.

So I will paste these details in range L3 of sheet 4

The main issue is I need to copy data for same names and paste in an e-mail.

So as per attached file, range B3:E9 will go in single email (new instance).


Range B12:E20 will go in single email (new instance).


Please check range B23:E32, this will also go in a single email.

Range G18 will go in a single email.
 

Attachments

  • Chandoo.xls
    30.5 KB · Views: 11
Last edited:

Hi Sachin !

It should be easier to work name by name …
When you start with a new name, clear Sheet4.
When you finish to copy filter results, you only have the data for one name.
Just export data (Sheet4.UsedRange for example) to an email
(see this forum threads on this forum or Ron de Bruin' site).

Precise a bit more the technical point of a difficulty if any …
​
 
Hi @Marc L , thanks a lot for the help. Good night.

Please see below code used by me, not done yet, halfway through only.

One of the main concern is I should not use same name again, for example if I have send mail one mail to Marc, then I should not be sending another mail to Marc.

Also, in sheet 1 Range B2:B5 is Marc, C2:C5 is Luke and sheet 2 Range B2:B5 is Marc, C2:C3 is Luke, C4:C5 in Sheet 2 is blank.

Then there will be two e-mails, one covering Sheet1 B2:C5 Sheet 2 B2:C3.
Second email will be Sheet 2 C4:C5.

As of now I am trying to make sure I am not missing ,repeating any name.

Then comes email formatting. :mad: :DD

Code: 
Sub Test()
Application.ScreenUpdating = False
    Dim CoreReport As Variant
    CoreReport = Application.GetOpenFilename(FileFilter:="Excel Files (*.), *.", Title:="Please select Core Report")
    If CoreReport = False Then Exit Sub
    Workbooks.Open Filename:=CoreReport
 
    Dim Cagiva As Workbook
    Set Cagiva = ActiveWorkbook
 
    '********************************************
    Dim Yamaha As Worksheet
    Set Yamaha = Cagiva.Worksheets("Yamaha")
 
    On Error Resume Next
        Yamaha.Select
        If Yamaha.Name <> "Yamaha" Then
            MsgBox "Yamaha is not present in the file, kindly re-check", vbCritical
            End
        End If
    On Error GoTo 0
 
    Dim TempRng As Range
    Dim TempLr As Long
    Dim TempCol As Long
 
    TempLr = Yamaha.Cells(Rows.Count, 1).End(xlUp).Row
    TempCol = Yamaha.Range("iv1").End(xlToLeft).Column
    Set TempRng = Yamaha.Range(Yamaha.Cells(1, 1), Yamaha.Cells(TempLr, TempCol))
 
    Cells.Select
    Selection.EntireColumn.Hidden = False
    Range("A1").Select
    TempRng.AutoFilter Field:=1, Criteria1:="=No", Operator:=xlOr, Criteria2:="="
 
    TempLr = Yamaha.Cells(Rows.Count, 1).End(xlUp).Row
    Set TempRng = Yamaha.Range(Yamaha.Cells(2, 1), Yamaha.Cells(TempLr, TempCol))
    TempRng.SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
 
    Range("A1").Select
    ActiveSheet.ShowAllData
 
    Cells.Select
    With Selection.Font
        .ColorIndex = xlAutomatic
    End With
 
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.ColumnWidth = 10
    Range("A1").Select
    '********************************************
    Dim Suzuki As Worksheet
    Set Suzuki = Cagiva.Worksheets("Suzuki")
 
    On Error Resume Next
        Suzuki.Select
        If Suzuki.Name <> "Suzuki" Then
            MsgBox "Suzuki is not present in the file, kindly re-check", vbCritical
            End
        End If
    On Error GoTo 0
 
    TempLr = Suzuki.Cells(Rows.Count, 1).End(xlUp).Row
    TempCol = Suzuki.Range("iv1").End(xlToLeft).Column
    Set TempRng = Suzuki.Range(Suzuki.Cells(1, 1), Suzuki.Cells(TempLr, TempCol))
 
    Cells.Select
    Selection.EntireColumn.Hidden = False
    Range("A1").Select
    TempRng.AutoFilter Field:=1, Criteria1:="=No", Operator:=xlOr, Criteria2:="="
 
    TempLr = Suzuki.Cells(Rows.Count, 1).End(xlUp).Row
    Set TempRng = Suzuki.Range(Suzuki.Cells(2, 1), Suzuki.Cells(TempLr, TempCol))
    TempRng.SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
 
    Range("A1").Select
    ActiveSheet.ShowAllData
 
    Cells.Select
    With Selection.Font
        .ColorIndex = xlAutomatic
    End With
 
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.ColumnWidth = 10
    Range("A1").Select
    '********************************************
    Yamaha.Select
    TempLr = Yamaha.Cells(Rows.Count, 1).End(xlUp).Row
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
 
    Suzuki.Select
    TempLr = Suzuki.Cells(Rows.Count, 1).End(xlUp).Row
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
 
    Yamaha.Select
    TempLr = Yamaha.Cells(Rows.Count, 1).End(xlUp).Row
    Range("B2").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[7],'Suzuki'!C[7],1,0),""Yamaha only"")"
    Range("B2:B" & TempLr).Formula = Range("B2").Formula
    Range("c2").FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
    Range("c2:c" & TempLr).Formula = Range("c2").Formula
    Range("B:C").Value = Range("B:C").Value
 
    Suzuki.Select
    TempLr = Suzuki.Cells(Rows.Count, 1).End(xlUp).Row
    Range("B2").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[7],'Yamaha'!C[7],1,0),""Suzukiirm only"")"
    Range("B2:B" & TempLr).Formula = Range("B2").Formula
    Range("c2").FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
    Range("c2:c" & TempLr).Formula = Range("c2").Formula
    Range("B:C").Value = Range("B:C").Value
    '********************************************
    'Sort
    Suzuki.Select
    Range("A1").Select
    Suzuki.AutoFilter.Sort.SortFields.Clear
    TempLr = Suzuki.Cells(Rows.Count, 1).End(xlUp).Row
 
    Suzuki.AutoFilter.Sort.SortFields.Add Key:=Suzuki.Range(Suzuki.Cells(2, 2), Suzuki.Cells(TempLr, 2)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 
    With Suzuki.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    Yamaha.Select
    Range("A1").Select
    Yamaha.AutoFilter.Sort.SortFields.Clear
    TempLr = Yamaha.Cells(Rows.Count, 1).End(xlUp).Row
    Yamaha.AutoFilter.Sort.SortFields.Add Key:=Yamaha.Range(Yamaha.Cells(2, 2), Yamaha.Cells(TempLr, 2)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 
    With Yamaha.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    '********************************************
    Yamaha.Range("B1").FormulaR1C1 = "vLookUp"
    Yamaha.Range("C1").FormulaR1C1 = "Countif"
 
    Suzuki.Range("B1").FormulaR1C1 = "vLookUp"
    Suzuki.Range("C1").FormulaR1C1 = "Countif"
    '********************************************
    'Unique
    Yamaha.Columns("B:B").Copy
    Sheets.Add
 
    Dim TempSht1 As Worksheet
    Set TempSht1 = ActiveSheet
    TempLr = TempSht1.Cells(Rows.Count, 1).End(xlUp).Row
 
    ActiveSheet.Paste
    ActiveSheet.Range("$A:$A").RemoveDuplicates Columns:=1, Header:=xlYes
 
    Suzuki.Columns("B:B").Copy
    ActiveSheet.Range("D1").PasteSpecial
    ActiveSheet.Range("$D:$D").RemoveDuplicates Columns:=1, Header:=xlYes
    Range("A1").Select
 
    TempLr = TempSht1.Cells(Rows.Count, 1).End(xlUp).Row
    Range("B2").FormulaR1C1 = "=VLOOKUP(RC[-1],'Yamaha'!C:C[1],2,0)"
    Range("b2:b" & TempLr).Formula = Range("B2").Formula
 
    Range("C2").FormulaR1C1 = "=IF(RC[-2]<>""Yamaha only"",VLOOKUP(RC[-2],'Suzuki'!C[-1]:C,2,0),0)"
    Range("C2:C" & TempLr).Formula = Range("C2").Formula
 
    TempLr = TempSht1.Cells(Rows.Count, 4).End(xlUp).Row
    Range("E2").FormulaR1C1 = "=VLOOKUP(RC[-1],'Suzuki'!C[-3]:C[-2],2,0)"
    Range("E2:E" & TempLr).Formula = Range("E2").Formula
 
    Range("F2").FormulaR1C1 = "=VLOOKUP(RC[-2],'Suzuki'!C[-4]:C[-2],3,0)"
    Range("F2:F" & TempLr).Formula = Range("F2").Formula
    Range("A:F").Value = Range("A:F").Value
    Columns("A:F").AutoFit
    '********************************************
    Dim BothPresent As Range
    TempLr = TempSht1.Cells(Rows.Count, 1).End(xlUp).Row
    Set TempRng = TempSht1.Range(TempSht1.Cells(2, 1), TempSht1.Cells(TempLr, 1))
 
 
 
 
 
Application.ScreenUpdating = True
End Sub
 
Last edited:

Sorry but I do not well understand your need …
In your file, Honda / Yamaha are they the same
that in your explanation Luke / Marc ?

My thinking was it should be easier to copy data to Sheet4
for an unique email and clear this worksheet for next email …

I let ninjas to give their point of view as I'm only a ronin !
​
 
Hi @Marc L , thanks for reminding me, I was about to post the code. Will post sample file in some time.

Was trying to upload yesterday itself but could not do due to some issues.

Have a nice day ahead. :)
 
Hi @Marc L , please find below code used by as per your convenience.
I will upload sample file shortly.

I aware this is not the ideal code but at present I was able to design in this way only. Trying to improve it as and when I get chance. I have replaced original terms with dummy code. PS. - Kindly ignore the code lines which mentions call mod01 or call mod02, these are for e-mail formatting. Thanks a lot for the help.

1st part of the code.
Code: 
Public MyReport As Workbook
Sub Email()
Application.ScreenUpdating = False
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("Trades_In_Both_Sheet")
   
    Dim FinalReport As Variant
    FinalReport = Application.GetOpenFilename(FileFilter:="Excel Files (*.), *.", Title:="Please select Report")
    If FinalReport = False Then Exit Sub
    Workbooks.Open Filename:=FinalReport
   
    Set MyReport = ActiveWorkbook
   
    '********************************************
    Dim MySheet1 As Worksheet
    Set MySheet1 = MyReport.Worksheets("Sheet Name 1")
   
    On Error Resume Next
        MySheet1.Select
        If MySheet1.Name <> "Sheet Name 1" Then
            MsgBox "Sheet Name 1 is not present in the file, kindly re-check", vbCritical
            End
        End If
    On Error GoTo 0
   
    MySheet1.Cells.Select
    Selection.EntireColumn.Hidden = False
    MySheet1.Cells.Copy
    Workbooks.Add
    Range("a1").PasteSpecial
    Set MyReport1 = ActiveWorkbook
   
    Dim TempRng As Range
    Dim TempLr As Long
    Dim TempCol As Long
   
    Set MySheet1 = MyReport1.Worksheets("Sheet1")
   
    TempLr = MySheet1.Cells(Rows.Count, 1).End(xlUp).Row
    TempCol = MySheet1.Range("iv1").End(xlToLeft).Column
    Set TempRng = MySheet1.Range(MySheet1.Cells(1, 1), MySheet1.Cells(TempLr, TempCol))
   
    Cells.Select
    Range("A1").Select
    TempRng.AutoFilter Field:=1, Criteria1:="=No", Operator:=xlOr, Criteria2:="="
   
    TempLr = MySheet1.Cells(Rows.Count, 1).End(xlUp).Row
    Set TempRng = MySheet1.Range(MySheet1.Cells(2, 1), MySheet1.Cells(TempLr, TempCol))
   
    Application.DisplayAlerts = False
        If TempLr > 1 Then
            TempRng.SpecialCells(xlCellTypeVisible).Delete
        End If
        Application.DisplayAlerts = True
    Range("A1").Select
    ActiveSheet.ShowAllData
   
    '********************************************
    Dim MySheet2 As Worksheet
    Set MySheet2 = MyReport.Worksheets("MySheet2")
   
    On Error Resume Next
        MyReport.Activate
        MySheet2.Select
        If MySheet2.Name <> "MySheet2" Then
            MsgBox "Sheet Name 1 is not present in the file, kindly re-check", vbCritical
            End
        End If
    On Error GoTo 0
   
    MySheet2.Cells.Select
    Selection.EntireColumn.Hidden = False
    MySheet2.Cells.Copy
    MyReport1.Activate
    Worksheets("Sheet2").Select
    Range("a1").PasteSpecial
   
    Set MySheet2 = MyReport1.Worksheets("Sheet2")
   
   
    Application.DisplayAlerts = False
        MyReport.Close
    Application.DisplayAlerts = True
   
    MyReport1.Activate
    Set MyReport = ActiveWorkbook
    Worksheets("Sheet1").Name = "Sheet Name 1"
    Worksheets("Sheet2").Name = "MySheet2"
   
    TempLr = MySheet2.Cells(Rows.Count, 1).End(xlUp).Row
    TempCol = MySheet2.Range("iv1").End(xlToLeft).Column
    Set TempRng = MySheet2.Range(MySheet2.Cells(1, 1), MySheet2.Cells(TempLr, TempCol))
   
    Range("A1").Select
    TempRng.AutoFilter Field:=1, Criteria1:="=No", Operator:=xlOr, Criteria2:="="
   
    TempLr = MySheet2.Cells(Rows.Count, 1).End(xlUp).Row
    Set TempRng = MySheet2.Range(MySheet2.Cells(2, 1), MySheet2.Cells(TempLr, TempCol))
   
    Application.DisplayAlerts = False
        If TempLr > 1 Then
            TempRng.SpecialCells(xlCellTypeVisible).Delete
        End If
    Application.DisplayAlerts = True
   
    Range("A1").Select
    ActiveSheet.ShowAllData
   
    '********************************************
    MySheet1.Select
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
   
    MySheet2.Select
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
   
    MySheet1.Select
    TempLr = MySheet1.Cells(Rows.Count, 1).End(xlUp).Row
   
   
    Range("B2").FormulaR1C1 = "=IFERROR(IF(RC[7]<>"""",VLOOKUP(RC[7],'MySheet2'!C[7],1,0),""""),""MySheet1 only"")"
    Range("B2:B" & TempLr).Formula = Range("B2").Formula
   
    Range("c2").FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
    Range("c2:c" & TempLr).Formula = Range("c2").Formula
    Range("B:C").Value = Range("B:C").Value
   
    MySheet2.Select
    TempLr = MySheet2.Cells(Rows.Count, 1).End(xlUp).Row
   
    Range("B2").FormulaR1C1 = "=IFERROR(IF(RC[7]<>"""",VLOOKUP(RC[7],'Sheet Name 1'!C[7],1,0),""""),""MySheet2 only"")"
    Range("B2:B" & TempLr).Formula = Range("B2").Formula
   
    Range("c2").FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
    Range("c2:c" & TempLr).Formula = Range("c2").Formula
    Range("B:C").Value = Range("B:C").Value
    '********************************************
    Range("A1").Select
    MySheet2.AutoFilter.Sort.SortFields.Clear
   
    MySheet2.AutoFilter.Sort.SortFields.Add Key:=MySheet2.Range(MySheet2.Cells(2, 2), MySheet2.Cells(TempLr, 2)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
    With MySheet2.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    MySheet1.Select
    Range("A1").Select
   
    MySheet1.AutoFilter.Sort.SortFields.Clear
    TempLr = MySheet1.Cells(Rows.Count, 1).End(xlUp).Row
    MySheet1.AutoFilter.Sort.SortFields.Add Key:=MySheet1.Range(MySheet1.Cells(2, 2), MySheet1.Cells(TempLr, 2)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
    With MySheet1.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    '********************************************
    TempCol = MySheet1.Range("iv1").End(xlToLeft).Column
    TempCol = MySheet2.Range("iv1").End(xlToLeft).Column

   
    MySheet1.Range("B1").FormulaR1C1 = "vLookUp"
    MySheet1.Range("C1").FormulaR1C1 = "Countif"
   
    MySheet2.Range("B1").FormulaR1C1 = "vLookUp"
    MySheet2.Range("C1").FormulaR1C1 = "Countif"
    '********************************************
    MySheet1.Columns("B:B").Copy
    Sheets.Add
   
    Dim TempSht1 As Worksheet
    Set TempSht1 = ActiveSheet
   
    ActiveSheet.Paste
    ActiveSheet.Range("$A:$A").RemoveDuplicates Columns:=1, Header:=xlYes
   
    MySheet2.Columns("B:B").Copy
    ActiveSheet.Range("D1").PasteSpecial
    ActiveSheet.Range("$D:$D").RemoveDuplicates Columns:=1, Header:=xlYes
   
    TempLr = TempSht1.Cells(Rows.Count, 1).End(xlUp).Row
   
    Range("B2").FormulaR1C1 = "=VLOOKUP(RC[-1],'Sheet Name 1'!C:C[1],2,0)"
    Range("b2:b" & TempLr).Formula = Range("B2").Formula
   
    Range("C2").FormulaR1C1 = "=IF(RC[-2]<>""MySheet1 only"",VLOOKUP(RC[-2],'MySheet2'!C[-1]:C,2,0),0)"
    Range("C2:C" & TempLr).Formula = Range("C2").Formula
 
2nd part of the code.

Code: 
TempLr = TempSht1.Cells(Rows.Count, 4).End(xlUp).Row
    Range("E2").FormulaR1C1 = "=VLOOKUP(RC[-1],'MySheet2'!C[-3]:C[-2],2,0)"
    Range("E2:E" & TempLr).Formula = Range("E2").Formula
   
    Range("F2").FormulaR1C1 = "=IF(RC[-2]<>""MySheet2 only"",VLOOKUP(RC[-2],'Sheet Name 1'!C[-4]:C[-3],2,0),0)"
    Range("F2:F" & TempLr).Formula = Range("F2").Formula
    '********************************************
   
    Dim BothPresent As Range
    TempLr = TempSht1.Cells(Rows.Count, 1).End(xlUp).Row
    Set BothPresent = TempSht1.Range(TempSht1.Cells(2, 1), TempSht1.Cells(TempLr, 1))
   
    Dim BothPresentSht As Worksheet
    Sheets.Add
    Set BothPresentSht = ActiveSheet
    BothPresentSht.Name = "BothSheetTrades"
   
    Dim CountSale As Long
    Dim TTTMapping As Worksheet
    Set TTTMapping = ThisWorkbook.Worksheets("EmailMapping")
    '********************************************
    If TempLr <> 1 Then
        For Each rn In BothPresent
            If rn.Value <> "MySheet1 only" Then
                If rn.Value <> " " Then
                    If rn.Value <> "Only" Then
                        If TTTMapping.Range("F2").Value <> " " Then
                            TTTMapping.Range("F2").Value = rn.Value
                            Call MyMod3
                        End If
                       
                        sh.Columns("R:BF").Clear
                       
                        MyReport.Activate
                        MySheet1.Select
                        Range("A1").Select
                       
                        Cells.Find(What:=rn, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                        False, SearchFormat:=False).Activate
                       
                        'CountIf of particular rn.value
                        CountSale = ActiveCell.Offset(0, 1).Value
                        ActiveCell.Offset(0, -1).Select
                       
                        MySheet1.Range(MySheet1.Cells(1, 1), MySheet1.Cells(1, TempCol + 1)).Copy Destination:=sh.Cells(1, 18)
                        ActiveCell.Resize(CountSale, TempCol + 1).Copy Destination:=sh.Cells(2, 18)
                       
                        ActiveCell.Resize(CountSale, 10).Value = "Only"
                       
                        MySheet2.Select
                        Range("A1").Select
                       
                        Cells.Find(What:=rn, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                        False, SearchFormat:=False).Activate
                       
                        CountSale = ActiveCell.Offset(0, 1).Value
                        ActiveCell.Offset(0, -1).Select
                       
                        MySheet2.Range(MySheet2.Cells(1, 1), MySheet2.Cells(1, TempCol + 1)).Copy Destination:=sh.Cells(1, 40)
                        ActiveCell.Resize(CountSale, TempCol + 1).Copy Destination:=sh.Cells(2, 40)
                       
                        ActiveCell.Resize(CountSale, 10).Value = "Only"
                       
                        ThisWorkbook.Activate
                        ThisWorkbook.Worksheets("Trades_In_Both_Sheet").Select
                        Call MyMod2
                       
                    End If
                End If
            End If
        Next
    End If
    '********************************************
    TempLr = MySheet1.Cells(Rows.Count, 1).End(xlUp).Row
    Set BothPresent = MySheet1.Range(MySheet1.Cells(2, 2), MySheet1.Cells(TempLr, 2))
   
    MyReport.Activate
    MySheet1.Select
    MySheet1.AutoFilter.Sort.SortFields.Add Key:=MySheet1.Range(MySheet1.Cells(2, 9), MySheet1.Cells(TempLr, 9)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
    With MySheet1.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    Range("c2").FormulaR1C1 = "=COUNTIF(C[6],RC[6])"
    Range("c2:c" & TempLr).Formula = Range("c2").Formula
    Range("B:C").Value = Range("B:C").Value
   
    Dim MySheet1Mail As Worksheet
    Set MySheet1Mail = ThisWorkbook.Worksheets("MySheet1")
   
    If TempLr <> 1 Then
        For Each rn In BothPresent
        TTTMapping.Range("F2").Clear
            If rn.Value = "MySheet1 only" Then
                If rn.Value <> "Only" Then
                    If rn.Value <> "" Then
                        MySheet1Mail.Range("R:BZ").Clear
                       
                        If TTTMapping.Range("F2").Value <> " " Then
                            TTTMapping.Range("F2").Value = rn.Offset(0, 7).Value
                            Call MyMod3
                        End If
                       
                        rn.Select
                        MySheet1.Range(MySheet1.Cells(1, 1), MySheet1.Cells(1, TempCol + 1)).Copy Destination:=MySheet1Mail.Range("R1")
                       
                        Range("A1").Select
                       
                        Cells.Find(What:=rn.Offset(0, 7).Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                        False, SearchFormat:=False).Activate
                       
                        CountSale = rn.Offset(0, 1).Value
                        rn.Offset(0, -1).Select
                        ActiveCell.Resize(CountSale, TempCol + 1).Copy Destination:=MySheet1Mail.Range("R2")
                       
                        ThisWorkbook.Activate
                        ThisWorkbook.Worksheets("MySheet1").Select
                        Call MailMySheet1
                        MyReport.Activate
                        rn.Resize(CountSale, 10).Value = "Only"
                    End If
                End If
            End If
        Next
    End If
    '********************************************
    MyReport.Activate
   
    TempLr = MySheet2.Cells(Rows.Count, 1).End(xlUp).Row
    Set BothPresent = MySheet2.Range(MySheet2.Cells(2, 2), MySheet2.Cells(TempLr, 2))
   
    MySheet2.Select
    MySheet2.AutoFilter.Sort.SortFields.Add Key:=MySheet2.Range(MySheet2.Cells(2, 9), MySheet2.Cells(TempLr, 9)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
    With MySheet2.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    MySheet2.Range("C2").FormulaR1C1 = "=COUNTIF(C[6],RC[6])"
    MySheet2.Range("C2:C" & TempLr).Formula = MySheet2.Range("C2").Formula
    MySheet2.Range("C2:C" & TempLr).Value = MySheet2.Range("C2:C" & TempLr).Value
   
    Set BothPresent = MySheet2.Range(MySheet2.Cells(2, 2), MySheet2.Cells(TempLr, 2))
   
    Dim MySheet2Mail As Worksheet
    Set MySheet2Mail = ThisWorkbook.Worksheets("MySheet2")
   
    If TempLr <> 1 Then
        For Each rn In BothPresent
        TTTMapping.Range("F2").Clear
            'rn.Select
            If rn.Value = "MySheet2 only" Then
                If rn.Value <> "Only" Then
                    If rn.Value <> "" Then
                   
                        MySheet2Mail.Range("R:BZ").Clear
                       
                        'If TTTMapping.Range("F2").Value <> " " Then
                            TTTMapping.Range("F2").Value = rn.Offset(0, 7).Value
                            Call MyMod3
                        'End If
                   
                        MySheet2.Select
                        BothPresentSht.Range("a:BZ").Clear
                       
                        MySheet1.Range(MySheet1.Cells(1, 1), MySheet1.Cells(1, TempCol + 1)).Copy Destination:=MySheet2Mail.Range("R1")
                       
                        Range("A1").Select
                       
                        Cells.Find(What:=rn.Offset(0, 7).Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                        False, SearchFormat:=False).Activate
                       
                        CountSale = rn.Offset(0, 1).Value
                        rn.Offset(0, -1).Select
                       
                        ActiveCell.Resize(CountSale, TempCol + 1).Copy Destination:=MySheet2Mail.Range("R2")
                       
                        ThisWorkbook.Activate
                        ThisWorkbook.Worksheets("MySheet2").Select
                        Call MailMySheet2
                       
                        MyReport.Activate
                        rn.Resize(CountSale, 10).Value = "Only"
                    End If
                End If
            End If
 
3rd part of the code.

Code: 
End If
    '********************************************
    TempLr = MySheet1.Cells(Rows.Count, 1).End(xlUp).Row
    MySheet1.Range("b2").FormulaR1C1 = "=IFERROR(IF(RC[8]<>"""",VLOOKUP(RC[8],'MySheet2'!C[8],1,0),""""),""MySheet1 only"")"
    MySheet1.Range("b2:b" & TempLr).Formula = MySheet1.Range("b2").Formula
    MySheet1.Range("b2:b" & TempLr).Value = MySheet1.Range("b2:b" & TempLr).Value
   
    MySheet1.Range("C2").FormulaR1C1 = "=COUNTIF(C[7],RC[7])"
    MySheet1.Range("C2:C" & TempLr).Formula = MySheet1.Range("C2").Formula
    MySheet1.Range("C2:C" & TempLr).Value = MySheet1.Range("C2:C" & TempLr).Value
   
    TempLr = MySheet2.Cells(Rows.Count, 1).End(xlUp).Row
    MySheet2.Range("b2").FormulaR1C1 = "=IFERROR(IF(RC[8]<>"""",VLOOKUP(RC[8],'Sheet Name 1'!C[8],1,0),""""),""MySheet2 only"")"
    MySheet2.Range("b2:b" & TempLr).Formula = MySheet2.Range("b2").Formula
    MySheet2.Range("b2:b" & TempLr).Value = MySheet2.Range("b2:b" & TempLr).Value
   
    MySheet2.Range("C2").FormulaR1C1 = "=COUNTIF(C[7],RC[7])"
    MySheet2.Range("C2:C" & TempLr).Formula = MySheet2.Range("C2").Formula
    MySheet2.Range("C2:C" & TempLr).Value = MySheet2.Range("C2:C" & TempLr).Value
   
    '*******************************************
    MySheet1.Select
    TempLr = MySheet1.Cells(Rows.Count, 1).End(xlUp).Row
   
    Range("B2").FormulaR1C1 = "=IFERROR(IF(RC[8]<>"""",VLOOKUP(RC[8],'MySheet2'!C[8],1,0),""""),""MySheet1 only"")"
    Range("B2:B" & TempLr).Formula = Range("B2").Formula
    Range("c2").FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
    Range("c2:c" & TempLr).Formula = Range("c2").Formula
    Range("B:C").Value = Range("B:C").Value
   
    MySheet2.Select
    TempLr = MySheet2.Cells(Rows.Count, 1).End(xlUp).Row
   
    Range("B2").FormulaR1C1 = "=IFERROR(IF(RC[8]<>"""",VLOOKUP(RC[8],'Sheet Name 1'!C[8],1,0),""""),""MySheet2 only"")"
    Range("B2:B" & TempLr).Formula = Range("B2").Formula
    Range("c2").FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
    Range("c2:c" & TempLr).Formula = Range("c2").Formula
    Range("B:C").Value = Range("B:C").Value
   
    'Sort
    MySheet2.Select
    Range("A1").Select
    MySheet2.AutoFilter.Sort.SortFields.Clear
   
    MySheet2.AutoFilter.Sort.SortFields.Add Key:=MySheet2.Range(MySheet2.Cells(2, 2), MySheet2.Cells(TempLr, 2)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
    With MySheet2.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    MySheet1.Select
    Range("A1").Select
    MySheet1.AutoFilter.Sort.SortFields.Clear
    TempLr = MySheet1.Cells(Rows.Count, 1).End(xlUp).Row
    MySheet1.AutoFilter.Sort.SortFields.Add Key:=MySheet1.Range(MySheet1.Cells(2, 2), MySheet1.Cells(TempLr, 2)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
    With MySheet1.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    'Unique
    MySheet1.Columns("B:B").Copy
    Sheets.Add
   
    Dim TempSht2 As Worksheet
    Set TempSht2 = ActiveSheet
   
    ActiveSheet.Paste
    ActiveSheet.Range("$A:$A").RemoveDuplicates Columns:=1, Header:=xlYes
   
    MySheet2.Select
    MySheet2.Columns("B:B").Copy
    TempSht2.Range("D1").PasteSpecial
    TempSht2.Range("$D:$D").RemoveDuplicates Columns:=1, Header:=xlYes
    TempSht2.Select
   
    TempLr = TempSht2.Cells(Rows.Count, 1).End(xlUp).Row
    Range("B2").FormulaR1C1 = "=VLOOKUP(RC[-1],'Sheet Name 1'!C:C[1],2,0)"
    Range("b2:b" & TempLr).Formula = Range("B2").Formula
   
    Range("C2").FormulaR1C1 = "=IF(RC[-2]<>""MySheet1 only"",VLOOKUP(RC[-2],'MySheet2'!C[-1]:C,2,0),0)"
    Range("C2:C" & TempLr).Formula = Range("C2").Formula
   
    TempLr = TempSht2.Cells(Rows.Count, 4).End(xlUp).Row
    Range("E2").FormulaR1C1 = "=VLOOKUP(RC[-1],'MySheet2'!C[-3]:C[-2],2,0)"
    Range("E2:E" & TempLr).Formula = Range("E2").Formula
   
    Range("F2").FormulaR1C1 = "=IF(RC[-2]<>""MySheet2 only"",VLOOKUP(RC[-2],'Sheet Name 1'!C[-4]:C[-3],2,0),0)"
    Range("F2:F" & TempLr).Formula = Range("F2").Formula
    Columns("A:F").ColumnWidth = 10
       
    Dim BothTTT As Range
    TempLr = TempSht2.Cells(Rows.Count, 1).End(xlUp).Row
    Set BothTTT = TempSht2.Range(TempSht2.Cells(2, 1), TempSht2.Cells(TempLr, 1))
   
    Dim BothTTTSheet As Worksheet
    Sheets.Add
    Set BothTTTSheet = ActiveSheet
    BothTTTSheet.Name = "BothTTTSheet"
   
    Dim TTTCount As Long
   
    '********************************************
    If TempLr <> 1 Then
    TTTMapping.Range("F2").Clear
        For Each rn In BothTTT
            If rn.Value <> "MySheet1 only" Then
                If rn.Value <> " " Then
                    If rn.Value <> "Only" Then
                       
                        If TTTMapping.Range("F2").Value <> " " Then
                            TTTMapping.Range("F2").Value = rn.Value
                            Call MyMod3
                        End If
                       
                        MyReport.Activate
                        sh.Columns("R:BF").Clear
                       
                        MySheet1.Select
                        Range("A1").Select
                       
                        Cells.Find(What:=rn, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                        False, SearchFormat:=False).Activate
                       
                        TTTCount = ActiveCell.Offset(0, 1).Value
                       
                        ActiveCell.Offset(0, -1).Select
                       
                        MySheet1.Range(MySheet1.Cells(1, 1), MySheet1.Cells(1, TempCol + 1)).Copy Destination:=sh.Cells(1, 18)
                        ActiveCell.Resize(TTTCount, TempCol + 1).Copy Destination:=sh.Cells(2, 18)
                       
                        ActiveCell.Resize(TTTCount, 10).Value = "Only"
                       
                        TempLr = BothTTTSheet.Cells(Rows.Count, 1).End(xlUp).Row + 3
                       
                        MySheet2.Select
                        Range("A1").Select
                       
                        Cells.Find(What:=rn, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                        False, SearchFormat:=False).Activate
                       
                        TTTCount = ActiveCell.Offset(0, 1).Value
                       
                        ActiveCell.Offset(0, -1).Select
                       
                        MySheet2.Range(MySheet2.Cells(1, 1), MySheet2.Cells(1, TempCol + 1)).Copy Destination:=sh.Cells(1, 40)
                        ActiveCell.Resize(CountSale, TempCol + 1).Copy Destination:=sh.Cells(2, 40)

                        ActiveCell.Resize(TTTCount, 10).Value = "Only"
                       
                       
                        ThisWorkbook.Activate
                        ThisWorkbook.Worksheets("Trades_In_Both_Sheet").Select
                        Call MyMod2
                        MyReport.Activate
                        BothTTTSheet.Range("A:Z").Clear
                    End If
                End If
            End If
        Next
    End If
   
    '********************************************
    MyReport.Activate
    Sheets.Add
    Set TTTMySheet2Sht = ActiveSheet
    TTTMySheet2Sht.Name = "TTTMySheet2Sht"
   
    TempLr = MySheet2.Cells(Rows.Count, 1).End(xlUp).Row
    Set BothPresent = MySheet2.Range(MySheet2.Cells(2, 2), MySheet2.Cells(TempLr, 2))
    MyReport.Activate
    MySheet2.Select
    MySheet2.AutoFilter.Sort.SortFields.Add Key:=MySheet2.Range(MySheet2.Cells(2, 10), MySheet2.Cells(TempLr, 10)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
    With MySheet2.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    MySheet2.Range("C2").FormulaR1C1 = "=COUNTIF(C[7],RC[7])"
    MySheet2.Range("C2:C" & TempLr).Formula = MySheet2.Range("C2").Formula
    MySheet2.Range("C2:C" & TempLr).Value = MySheet2.Range("C2:C" & TempLr).Value
   
    MySheet2.Select
    TTTMapping.Range("F2").Clear
    If TempLr <> 1 Then
 
4th part of the code.

Code: 
For Each rn In BothPresent
            MySheet2.Select
            TTTMySheet2Sht.Range("A:Z").Clear
            'rn.Select
            If rn.Value = "MySheet2 only" Then
                If rn.Value <> "Only" Then
                    If rn.Value <> "" Then
                       
                        MySheet2Mail.Range("R:BZ").Clear
                       
                        TTTMapping.Range("F2").Value = rn.Offset(0, 8).Value
                        Call MyMod3
                       
                       
                        BothPresentSht.Range("a:BZ").Clear
                   
                        MySheet1.Range(MySheet1.Cells(1, 1), MySheet1.Cells(1, TempCol + 1)).Copy Destination:=MySheet2Mail.Range("R1")
                       
                        Range("A1").Select
                       
                        Cells.Find(What:=rn.Offset(0, 7).Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                        False, SearchFormat:=False).Activate
                       
                        TTTCount = rn.Offset(0, 1).Value
                        rn.Offset(0, -1).Select
                       
                        ActiveCell.Resize(TTTCount, TempCol + 1).Copy Destination:=MySheet2Mail.Range("R2")
                       
                        ThisWorkbook.Activate
                        ThisWorkbook.Worksheets("MySheet2").Select
                        Call MailMySheet2
                       
                        MyReport.Activate
                        rn.Resize(TTTCount, 10).Value = "Only"
                    End If
                End If
            End If
        Next
    End If
    '********************************************
    TempLr = MySheet1.Cells(Rows.Count, 1).End(xlUp).Row
    Set BothPresent = MySheet1.Range(MySheet1.Cells(2, 2), MySheet1.Cells(TempLr, 2))
   
    MySheet1.Select
    MySheet1.AutoFilter.Sort.SortFields.Add Key:=MySheet1.Range(MySheet1.Cells(2, 10), MySheet1.Cells(TempLr, 10)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
    With MySheet1.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    MySheet1.Range("C2").FormulaR1C1 = "=COUNTIF(C[7],RC[7])"
    MySheet1.Range("C2:C" & TempLr).Formula = MySheet1.Range("C2").Formula
    MySheet1.Range("C2:C" & TempLr).Value = MySheet1.Range("C2:C" & TempLr).Value
   
    MySheet1Mail.Range("R:BZ").Clear
    For Each rn In BothPresent
    TTTMapping.Range("F2").Clear
        MySheet1.Select
        TTTMySheet2Sht.Range("A:Z").Clear
        If rn.Value = "MySheet1 only" Then
            'If rn.Interior.Color <> "Only" Then
                If rn.Value <> "" Then
                    MySheet1Mail.Range("R:BZ").Clear
                   
                    TTTMapping.Range("F2").Value = rn.Offset(0, 8).Value
                    Call MyMod3
                   
                    MySheet1.Range(MySheet1.Cells(1, 1), MySheet1.Cells(1, TempCol + 1)).Copy Destination:=MySheet1Mail.Range("R1")
                   
                    Range("A1").Select
                   
                    Cells.Find(What:=rn.Offset(0, 7).Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                    False, SearchFormat:=False).Activate
                   
                    TTTCount = rn.Offset(0, 1).Value
                    rn.Offset(0, -1).Select
                   
                    ActiveCell.Resize(TTTCount, TempCol + 1).Copy Destination:=MySheet1Mail.Range("R2")
                   
                    ThisWorkbook.Activate
                    ThisWorkbook.Worksheets("MySheet1").Select
                    Call MailMySheet1
                   
                    MyReport.Activate
                    rn.Resize(TTTCount, 10).Value = "Only"
                End If
            'End If
        End If
    Next
    '********************************************
    MsgBox "Done !"
    Application.ScreenUpdating = True
End Sub
 
Hi @Marc L L, I will upload sample file and will inform you, sorry for delay.

PS - Hi @Marc L , please find attached file for your reference.
 

Attachments

  • Chandoo.xlsx
    13.2 KB · Views: 11
Last edited:

What are Format1 to 6 in Sheet1 ?

I do not understand why separate data in same mail ?
Can you display a final sample mail in a worksheet ?
​
 
Hi @Marc L , really sorry for late reply.

Range A26:M34, mail 1, reason, Sachin is present in both the sheets.

Range A37:M43, mail 2, format same as mail 1, however name here is different, Rahul, that is why in a different e-mail.

mails will be sent as per the names present in column I and J, that is why different e-mails.

Since I have started from Column I, so for Sachin present in both sheets, that will be in one e-mail.

Rahul present in both sheets in Column I, will be in a different e-mail.

Range A46:M49, Brian, only present in sheet 1, (Column I), that will be in a different e-mail.

Range A52, Saurav is present only in sheet 1, that is why in a different e-mail.
 
As samples are not following exactly explanations
(or maybe I do not well understand your need),
all I could do is this demonstration :​
Code: 
Sub Demo00()
Dim Rg1 As Range, Rg2 As Range
              Set Rg2 = Sheet2.Cells(1).CurrentRegion
With Sheet1
              Set Rg1 = .Cells(1).CurrentRegion
    For C& = 9 To 10
        .Cells(C).Copy Union(.Cells(16), .Cells(18), .Cells(20))
        .[P2].Value = "<>":
        Rg1.Columns(C).AdvancedFilter xlFilterCopy, .[P1:P2], .Cells(18), True
        Rg2.Columns(C).AdvancedFilter xlFilterCopy, .[P1:P2], .Cells(20), True
  
        For R& = 2 To .Cells(18).CurrentRegion.Rows.Count
            Sheet3.UsedRange.Clear
            .Cells(R, 18).Copy .[P2]
            Rg1.AdvancedFilter xlFilterCopy, .[P1:P2], Sheet3.Cells(1)
  
            If IsNumeric(Application.Match(.Cells(R, 18).Value, .Cells(20).CurrentRegion, 0)) Then
                Rg2.AdvancedFilter xlFilterCopy, .[P1:P2], Sheet3.Cells(Rows.Count, 1).End(xlUp)(3)
          
            End If
  
            Stop
        Next
  
        For R& = 2 To .Cells(20).CurrentRegion.Rows.Count
            If IsError(Application.Match(.Cells(R, 20).Value, .Cells(18).CurrentRegion, 0)) Then
                Sheet3.UsedRange.Clear
                .Cells(R, 20).Copy .[P2]
                Rg2.AdvancedFilter xlFilterCopy, .[P1:P2], Sheet3.Cells(1)
  
                Stop
            End If
        Next
    Next
End With
  
Set Rg1 = Nothing:  Set Rg2 = Nothing
End Sub
At each Stop, check Sheet3 as an e-mail …​
 
Last edited:
Hi @Marc L , thanks a lot for the help. I am really sorry for not uploading sample files. I am trying your code, will revert with details.

I will try to explain my requirement once again, not your mistake, I know it's confusing without proper sample files.

Have a nice day ahead. :)
 
In fact samples files are not really a need with a complete explanation !
With source worksheet it's an easier support to write a code …

As it just seems to copy filtered data - maybe I'm wrong again - with
explicit criterias / rules per column you should have a solution
within the next 24 hours from your initial post !
​
 
Hi @Marc L , amazing would be an understatement !
It took me around 500 lines of code to get the results and still I am not sure.

You have done it in 35 lines flat !
 

My first try is the one ? Amazing !
I thought it will need at least a mod for second column ('cause of samples) …

35 lines flat : advanced filter POWERRRRRrrrrr ‼
​
 
You must log in or register to reply here.
Back
Top