VBA - Compare values in one range to another range

[Ron512]

I need some help getting started with a macro to compare values in one range to another range.

Range1 is the baseline so if Range2 has a value that is not in the Range1 it is highlighted, If Range2 does not have a value that is in Range1 that value is copied from Range1 to another column. The values do not line up with each other by row so each value in Range1 must be compared to each value in Range2. Both ranges are single columns and the values are strings.

Thanks

Ron

 

[sweater_vests_rock]

Hi Ron.

Try this on a copy of your data. Because I didn't have the details, right now the code doesn't paste the unique values anywhere...

Ben.

Sub RangeCompare()
'   sweater_vests_rock, 17 Jan 2011

'   Post:
'   Range1 is the baseline so if Range2 has a value that is not in the Range1 it is highlighted
'   If Range2 does not have a value that is in Range1 that value is copied from Range1 to another column.
'   The values do not line up with each other by row so each value in Range1 must be compared to each value
'   in Range2. Both ranges are single columns and the values are strings.

'   Notes:
'   Uses ColorIndex = 6 (yellow in default XL colors) as highlight color

    Dim Range1 As Range, Range2 As Range, c As Range
    
    On Error Resume Next
    
    Set Range1 = Application.InputBox("Select Range1:", Title:="Get Range1", Type:=8)
    If Range1 Is Nothing Then
        MsgBox "No range selected. Ending program..."
        Exit Sub
    End If
    
    Set Range2 = Application.InputBox("Select Range2:", Title:="Get Range2", Type:=8)
    If Range1 Is Nothing Then
        MsgBox "No range selected. Ending program..."
        Exit Sub
    End If
    
    On Error GoTo 0
    
'   Highlight values not in Range1
    For Each c In Range2.Cells
        If Application.WorksheetFunction.CountIf(Range1, c.Value) = 0 Then
            c.Interior.ColorIndex = 6
        End If
    Next c
    
'   Move values from Range1 not in Range2
    For Each c In Range1.Cells
        If Application.WorksheetFunction.CountIf(Range2, c.Value) = 0 Then
            c.Copy 'Put copy destination here
            Application.CutCopyMode = False
        End If
    Next c
        
End Sub

 

[Ron512]

Hey Ben,

It works perfectly.

Thanks.

Ron

 

[Pretty1996]

Hi, looking at the code if I use

c.Copy Destination:=Worksheets("sheet1").Range("e1")

it doesnt seem to copy and paste all values in range 1, is there another method of doing the copy to destination?

I've tried

    Range("E1").Select
    ActiveSheet.Paste

but that didnt really work either.

regards

 

[sweater_vests_rock]

Hi, looking at the code if I use

c.Copy Destination:=Worksheets("sheet1").Range("e1")

it doesnt seem to copy and paste all values in range 1, is there another method of doing the copy to destination?

I've tried

    Range("E1").Select
    ActiveSheet.Paste

but that didnt really work either.

regards

Sorry, I didn't really feel like I had enough data to really manage this part of the code. The reason you're not seeing distinct values is the code as written will copy each value on top of the other (so you only ever get the last value). This update should handle it ok.

Sub RangeCompare()
'   sweater_vests_rock, 17 Jan 2011

'   Post:
'   Range1 is the baseline so if Range2 has a value that is not in the Range1 it is highlighted
'   If Range2 does not have a value that is in Range1 that value is copied from Range1 to another column.
'   The values do not line up with each other by row so each value in Range1 must be compared to each value
'   in Range2. Both ranges are single columns and the values are strings.

'   Notes:
'   Uses ColorIndex = 6 (yellow in default XL colors) as highlight color
'   rgPaste defines the location of the pasted value.  By assumption, this is a column range.

    Dim Range1 As Range, Range2 As Range, c As Range, rgPaste As Range
    
    On Error Resume Next
    
    Set Range1 = Application.InputBox("Select Range1:", Title:="Get Range1", Type:=8)
    If Range1 Is Nothing Then
        MsgBox "No range selected. Ending program..."
        Exit Sub
    End If
    
    Set Range2 = Application.InputBox("Select Range2:", Title:="Get Range2", Type:=8)
    If Range1 Is Nothing Then
        MsgBox "No range selected. Ending program..."
        Exit Sub
    End If
    
    Set rgPaste = Application.InputBox("Select first cell in the paste range:", Title:="Get Start of Paste Range", Type:=8)
    If rgPaste Is Nothing Then
        MsgBox "No range selected. Ending program..."
        Exit Sub
    End If

'   Truncate paste range to first cell
    Set rgPaste = rgPaste.Cells(1, 1)
    
    On Error GoTo 0
    
'   Highlight values not in Range1
    For Each c In Range2.Cells
        If Application.WorksheetFunction.CountIf(Range1, c.Value) = 0 Then
            c.Interior.ColorIndex = 6
        End If
    Next c
    
'   Move values from Range1 not in Range2
    For Each c In Range1.Cells
        If Application.WorksheetFunction.CountIf(Range2, c.Value) = 0 Then
            c.Copy rgPaste
            Set rgPaste = rgPaste.Offset(1, 0)
        End If
    Next c
        
    Application.CutCopyMode = False
        
End Sub

 

[HalfAce]

Ron512,
Here's another option that doesn't require the user to select any ranges, it just assumes your 2 lists are in columns A & B, and assumes you want the values from column B that are not in column A, to be displayed in column C.

Sub CompareLists()
Dim Rng As Range, RngList As Object

Set RngList = CreateObject("Scripting.Dictionary")

'''Make a list of the ColumnB items...
For Each Rng In Range("B1", Range("B" & Rows.Count).End(xlUp))
  If Not RngList.Exists(Rng.Value) Then
    RngList.Add Rng.Value, Nothing
  End If
Next

'''Go through Col.A and test for existance of each value in Col.B
'''(Highlight items in Column A that are NOT found in Column B)
For Each Rng In Range("A1", Range("A" & Rows.Count).End(xlUp))
  If Not RngList.Exists(Rng.Value) Then
    Rng.Font.ColorIndex = 3
  End If
Next

Set RngList = CreateObject("Scripting.Dictionary")

'''Make a list of the ColumnA items...
For Each Rng In Range("A1", Range("A" & Rows.Count).End(xlUp))
  If Not RngList.Exists(Rng.Value) Then
    RngList.Add Rng.Value, Nothing
  End If
Next

'''Go through Col.B and test for existance of each value in Col.A
'''(Display in Column C, the Column B items NOT found in Column A)
  For Each Rng In Range("B1", Range("B" & Rows.Count).End(xlUp))
    If Not RngList.Exists(Rng.Value) Then
      Cells(Rows.Count, "C").End(xlUp)(2).Value = Rng.Value
    End If
  Next
  
Set List = Nothing

End Sub

Hope it helps.







Pretty 1996,

if I use...
c.Copy Destination:=Worksheets("sheet1").Range("e1")
it doesn't seem to copy and paste all values in range 1

That line (from what Sweater Vest posted) is only copying a single cell at a time, not a (multiple cell) range, and, the way your destination is (currently) written, it will always be pasted to sheet 1 range E1. (Therefore overwriting the last value that just got pasted there...)

(Does that help?)

EDIT:
A little late with the response I see. (Asleep at the light again I guess...)

 

[sweater_vests_rock]

Thanks HalfAce! I think your code should run a lot faster on a large list. I never think to use the dictionary stuff

 

[HalfAce]

Ahh, can't take the credit myself, that would be jindon. He's the one I picked it up from.

 

[Ron512]

I didn’t think to note for those others viewing this post that I made some changes to Bens code to paste the values, I did it like this.

'   Move values from Range1 not in Range2
    For Each c In Range1.Cells
        If Application.WorksheetFunction.CountIf(Range2, c.Value) = 0 Then
        RowCount = RowCount + 1
            c.Copy Cells(RowCount, 4) 'Put copy destination here
            Application.CutCopyMode = False
        End If
    Next c

But I like how Ben’s second post handles it.

HalfAce
I’m unfamiliar with dictionaries. Thanks for introducing me to something new, it’s great to learn new stuff.

Ron

 

[Pretty1996]

Hi guys,

thanks for all the posts above...

im trying to understand the code provided by half ace.

I dont really understand scripting dictionaries, but reading about them I understand that each dictionary item requires a key but I dont really see where you are adding the key in the below code...

For Each Rng In Range("B1", Range("B" & Rows.Count).End(xlUp))
  If Not RngList.Exists(Rng.Value) Then
    RngList.Add Rng.Value, Nothing
  End If
Next

thanks

regards
Sukh