Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Excel / Programming / March 2006

Tip: Looking for answers? Try searching our database.

How do you compare 2 list of numbers and highlight the difference

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
Jay Jones - 20 Mar 2006 16:06 GMT
I have to compare 2 lists of numbers every month and find the difference
between them
Peter Rooney - 20 Mar 2006 17:49 GMT
Jay,

See if you can adapt this:

Sub ListCompare()
   Dim CompSheet As Worksheet
   
   Dim List1 As Range 'range of cells containing your first list eg B3:B32
   Dim List1Header As Range 'label at the top of list 1 e.g. B2
   Dim List1Item As Range
   
   Dim List2 As Range 'range of cells containing your second list e.g.D3:D32
   Dim List2Header As Range 'label at the top of list 1 e.g. D2
   Dim List2Item As Range
       
   Dim List1OnlyHeader As Range 'label above where you want items found
ONLY in first list to appear e.g.F2
   Dim List2OnlyHeader As Range 'label above where you want items found
ONLY in second list to appear e.g. H2
   Dim ListBothHeader As Range 'label above where you want items found in
BOTH lists to appear e.g. J2
   
   Dim Flag As Boolean
   
   'In my example, List1 is B3:B32 and List2 is D3:D32, although the code
works out
   'how long the lists are and allocates the names List1 and List2 to the
cells containing them (the
   'data only, not the headers).
   
   'Make sure that there is a blank column to the left of List1Header, and
blank
   'columns between List1OnlyHeader and List2OnlyHeader, and between
List2OnlyHeader and ListBothHeader.
   
   'Finally, make sure there is a blank column to the right of
ListBothHeader.
   'This ensures that all the "CurrentRegion" referenece work correctly.
   'In my example:
   '   Cell F2 contains the label "List1Only" and has a range name of
"List1OnlyHeader",
   '   Cell H2 contains the label "List2Only" and has a range name of
"List2OnlyHeader",
   '   Cell J2 contains the label "Both" and has a range name of
"ListBothHeader",
   
   'Columns A, D, E, G, I and K must be blank (or at the very least,
mustn't contain data adjacent to the
   'entries in columns B, D, F, H and K.
   'The worksheet is called "Compare Lists"
   
   Set CompSheet = Worksheets("Compare Lists")
       
   Set List1Header = CompSheet.Range("List1Header")
   Set List1OnlyHeader = CompSheet.Range("List1OnlyHeader")
   Set List2Header = CompSheet.Range("List2Header")
   Set List2OnlyHeader = CompSheet.Range("List2OnlyHeader")
   Set ListBothHeader = CompSheet.Range("ListBothHeader")
   
   If List1Header.CurrentRegion.Rows.Count = 1 Then
       MsgBox ("You don't have any entries in List 1!")
       Exit Sub
   End If
   
   If List2Header.CurrentRegion.Rows.Count = 1 Then
       MsgBox ("You don't have any entries in List 2!")
       Exit Sub
   End If
   
   List1Header.Offset(1, 0).Resize(List1Header.CurrentRegion.Rows.Count -
1, 1).Name = "List1"
   List2Header.Offset(1, 0).Resize(List2Header.CurrentRegion.Rows.Count -
1, 1).Name = "List2"
   
   Set List1 = CompSheet.Range("List1")
   Set List2 = CompSheet.Range("List2")
   
   'Clear List1 only entries produced when macro last run
   If List1OnlyHeader.CurrentRegion.Rows.Count > 1 Then
       List1OnlyHeader.Offset(1,
0).Resize(List1OnlyHeader.CurrentRegion.Rows.Count - 1).ClearContents
   End If
   'Clear List2 only entries produced when macro last run
   If List2OnlyHeader.CurrentRegion.Rows.Count > 1 Then
       List2OnlyHeader.Offset(1,
0).Resize(List2OnlyHeader.CurrentRegion.Rows.Count - 1).ClearContents
   End If
   'Clear ListBoth entries produced when macro last run
   If ListBothHeader.CurrentRegion.Rows.Count > 1 Then
       ListBothHeader.Offset(1,
0).Resize(ListBothHeader.CurrentRegion.Rows.Count - 1).ClearContents
   End If
   
   'Check which items are only in list 1 and not in List 2
   For Each List1Item In List1
       Flag = False
       For Each List2Item In List2
           If List2Item.Value = List1Item.Value Then
               Flag = True
           End If
       Next
       If Flag = False Then
           'MsgBox (List1Item.Value & " is only in List 1!")
           List1OnlyHeader.Offset(List1OnlyHeader.CurrentRegion.Rows.Count,
0).Value = List1Item.Value
       Else
           'MsgBox (List1Item.Value & " is in both Lists!")
           ListBothHeader.Offset(ListBothHeader.CurrentRegion.Rows.Count,
0).Value = List1Item.Value
       End If
   Next
       
   'Check which items are only in list 2 and not in List 1
   For Each List2Item In List2
       Flag = False
       For Each List1Item In List1
           If List1Item.Value = List2Item.Value Then
               Flag = True
           End If
       Next
       If Flag = False Then
           'MsgBox (List2Item.Value & " is only in List 2!")
           List2OnlyHeader.Offset(List2OnlyHeader.CurrentRegion.Rows.Count,
0).Value = List2Item.Value
       Else 'Included only for completeness - you already worked out which
items
            'were in both lists in the previous loop!
            'MsgBox (List2Item.Value & " is in both Lists!")
            'ListBothHeader.Offset(ListBothHeader.CurrentRegion.Rows.Count,
0).Value = List2Item.Value
       End If
   Next

   'Sort List1Only list
   List1OnlyHeader.CurrentRegion.Sort Key1:=Range("List1OnlyHeader"), _
       Order1:=xlAscending, Header:=xlGuess, _
           OrderCustom:=1, MatchCase:=False, _
               Orientation:=xlTopToBottom

   'Sort List2Only list
   List2OnlyHeader.CurrentRegion.Sort Key1:=Range("List2OnlyHeader"), _
       Order1:=xlAscending, Header:=xlGuess, _
           OrderCustom:=1, MatchCase:=False, _
               Orientation:=xlTopToBottom

   'Sort ListBoth list
   ListBothHeader.CurrentRegion.Sort Key1:=Range("ListBothHeader"), _
       Order1:=xlAscending, Header:=xlGuess, _
           OrderCustom:=1, MatchCase:=False, _
               Orientation:=xlTopToBottom

End Sub

Hope it's of some use

Pete

> I have to compare 2 lists of numbers every month and find the difference
> between them
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.