Compare two cells in a column, if TRUE, then compare the two rows colymn by column

ExcelSwede

New Member
Joined
Mar 9, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Hi all helpful people. First, sorry about my English. I hope you´ll understand anyway.

I have several long mailinglists in Excel. One list for a specific purpose or a specific occation. Each list can include several adresses which can occure in another list. I will try to copy one list at a time, paste them into the same sheet and let the purpose for the list show in a specifik column. Then I want a macro to do this job:

Sub
sort by emailadress (col A)
Compare row 1 with row 2; row 2 with row 3; row 3 with row 4; and so on....
If two cells are equal, then column by column compare purposes and make the two compared rows similar. After being similar, i can delete one of the rows.
When all e-mailadresses are compared, I have a list where an emailadress only occure once, and for each emailaderess I can sort a column for a purpose and then copy the adresses that belongs to the desired purpose.
Endsub

Voilá!!

Starting position - duplicates of adresses
1615319388828.png


Sorted list
1615319427928.png


Comparing (illustrated by green cells)
1615319510638.png


Make rows silmilare
1615319579842.png


Delete one of the similare rows
1615319660754.png


Find, compare, make similare and delete one of next couple
If an emailadress occures more then twice (like dog, horse and pig below) I suppose its easiest to loop the macro several times until there is no more find couples.

1615319776496.png


In the end there is a sorted list and each emailadress has been saved with all different purposes.
1615319979580.png


Now, perhaps I want to email all adresses that are marked with purpose No 2, so I simply sort by that column and then select the adresses, copy and paste into Outlook.
1615320413823.png


All ExcelGuru's out there. Can this dream of mine became true?

Big hug for a clever solution.
ExcelSwede
 

Attachments

  • 1615319135483.png
    1615319135483.png
    23.7 KB · Views: 4

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,772
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
How about
VBA Code:
Sub ExcelSwede()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   Ary = Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To ubund(Ary), 1 To UBound(Ary, 2))
   
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         If Not .Exists(Ary(r, c)) Then
            nr = nr + 1
            For c = 1 To UBound(Ary, 2)
               If Ary(r, c) <> "" Then Nary(nr, c) = Ary(r, c)
            Next c
         Else
            For c = 2 To UBound(Ary, 2)
               If Ary(r, c) <> "" Then Nary(.Item(Ary(r, c)), c) = Ary(r, c)
            Next c
         End If
      Next r
   End With
   Range("A1").CurrentRegion.ClearContents
   Range("A1").Resize(nr, UBound(Nary, 2)).Value = Nary
End Sub
 

ExcelSwede

New Member
Joined
Mar 9, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
How about
VBA Code:
Sub ExcelSwede()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
  
   Ary = Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To ubund(Ary), 1 To UBound(Ary, 2))
  
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         If Not .Exists(Ary(r, c)) Then
            nr = nr + 1
            For c = 1 To UBound(Ary, 2)
               If Ary(r, c) <> "" Then Nary(nr, c) = Ary(r, c)
            Next c
         Else
            For c = 2 To UBound(Ary, 2)
               If Ary(r, c) <> "" Then Nary(.Item(Ary(r, c)), c) = Ary(r, c)
            Next c
         End If
      Next r
   End With
   Range("A1").CurrentRegion.ClearContents
   Range("A1").Resize(nr, UBound(Nary, 2)).Value = Nary
End Sub
Deeply impressed of your kindness. But unfortunatly, I got an error. Sorry about Swedish text i Msg-box, but sure you can figure it out. Looking forward to next try :) ExcelSwede

1615327875935.png
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,772
Office Version
  1. 365
Platform
  1. Windows
That's a typo it should be Ubound
 

ExcelSwede

New Member
Joined
Mar 9, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Deeply impressed of your kindness. But unfortunatly, I got an error. Sorry about Swedish text i Msg-box, but sure you can figure it out. Looking forward to next try :) ExcelSwede

View attachment 33936


Sorry, saw right now that it was a simple failure, just spelling.
But, when this was corrected, another failure occures. Says that "index is out of range". That is mauch harder for me to adjust.....

1615328711679.png
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,772
Office Version
  1. 365
Platform
  1. Windows
I realised that there were a number of problems. Trying to do it in a hurry never pays.
Try this version
VBA Code:
Sub ExcelSwede()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
   
   Ary = Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
   
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         If Not .Exists(Ary(r, 1)) Then
            nr = nr + 1
            .Add Ary(r, 1), nr
            For c = 1 To UBound(Ary, 2)
               If Ary(r, c) <> "" Then Nary(nr, c) = Ary(r, c)
            Next c
         Else
            For c = 2 To UBound(Ary, 2)
               If Ary(r, c) <> "" Then Nary(.Item(Ary(r, 1)), c) = Ary(r, c)
            Next c
         End If
      Next r
   End With
   Range("A1").CurrentRegion.ClearContents
   Range("A1").Resize(nr, UBound(Nary, 2)).Value = Nary
End Sub
 
Solution

ExcelSwede

New Member
Joined
Mar 9, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

I realised that there were a number of problems. Trying to do it in a hurry never pays.
Try this version
VBA Code:
Sub ExcelSwede()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, nr As Long
  
   Ary = Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
  
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary)
         If Not .Exists(Ary(r, 1)) Then
            nr = nr + 1
            .Add Ary(r, 1), nr
            For c = 1 To UBound(Ary, 2)
               If Ary(r, c) <> "" Then Nary(nr, c) = Ary(r, c)
            Next c
         Else
            For c = 2 To UBound(Ary, 2)
               If Ary(r, c) <> "" Then Nary(.Item(Ary(r, 1)), c) = Ary(r, c)
            Next c
         End If
      Next r
   End With
   Range("A1").CurrentRegion.ClearContents
   Range("A1").Resize(nr, UBound(Nary, 2)).Value = Nary
End Sub
Deeply, deeeply, deeeeeply impressed. Fluff = Wizard of Excel!
Works absolutley perfect.
I joined this forum a few hours ago. Before, i've tried lots of ours without getting it solved. So greatful.
Now time has past midnight here in Sweden. Have to get some rest.
By the way, the only thing this code doesen't do, which I thought was necessary, is to sort data in column A in alphabetic order. How can it compare rows without first getting them sorted? For excellent performance, can you add a sorting in alphabetic order in column A?

sincerely
ExcelSwede
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,772
Office Version
  1. 365
Platform
  1. Windows
I didn't see the point in sorting the data, as you said you would be sorting the data by different columns to get the emails you wanted.
 

ExcelSwede

New Member
Joined
Mar 9, 2021
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Hello Fluff!
Again, thank you for the macro. I forgot my promise from the start of this thread.
1615556322500.png

So - Big hug ;)

And after that, a new question - Is it possible to ask if you can make some comments in the macro? I have tried to understand how it works but I am not sure if I got it.

Two arrays, one i load the other if terms are as stipulated. Or?

Happy weekend!
ExcelSwede
 

Attachments

  • 1615556291238.png
    1615556291238.png
    21 KB · Views: 2

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,772
Office Version
  1. 365
Platform
  1. Windows
If you comment the code with what you think is happening & post it here, I will fill in the blanks & correct any misunderstandings.
 

Forum statistics

Threads
1,143,909
Messages
5,721,461
Members
422,363
Latest member
Bogus_Potatoes

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