PDA

View Full Version : Solved: Check one range against another



Card Maker
01-10-2007, 03:40 PM
Hi all - I'm back again!

Gosh it's been a while, but hopefully one of you geniuses will be able to help. :thumb

I have 2 sheets. Sheet1 contains a set of words in columns A, B and C. Duplicates are possible. Sheet2 contains a set of words in column A, with no duplicates allowed. When someone adds a word to Sheet1 (in any column), I would like to have Excel look through all the words on Sheet1, match them against Sheet2 and if there are any new words not already in Sheet2, then add them to the end of the list.

But my code doesn't seem to work. :dunno I've tried to pick bits and pieces of code I found here and put it all together but I've done something wrong somewhere!

Sub CheckNewWords()
Dim existRng As Range
Dim wordsRng As Range
Dim Rng1 As Range
Dim Rng2 As Range
Dim bMatch As Boolean

On Error Resume Next
Set existRng = Sheets("Sheet2").Range("A1", Range("A65536").End(xlUp))
Set wordsRng = Sheets("Sheet1").Range("A1", Range("C65536").End(xlUp))

For Each Rng1 In wordsRng
bMatch = False
For Each Rng2 In existRng
If Rng1 = Rng2 Then
bMatch = True
End If
Next Rng2
If bMatch = False Then
existRng.End(xlUp).Offset(1, 0).Value = Rng1
End If
Next Rng1
End Sub I don't get any errors - it just doesn't do anything! What have I done wrong?

Thanks again for your help!

Ann

Ken Puls
01-10-2007, 04:20 PM
Are they just entering a single word in the cell, or are you trying to check for any word in a string that's not in the list on Sheet2?

Do you want to check automagically each time a word is entered, or trigger the process manually every now and then?

Ken Puls
01-10-2007, 04:22 PM
OH! And btw... the reason you get no errors has a lot to do with this line in your code:

On Error Resume Next

If you don't have a good reason for it being there, I would suggest you remove it, as it will mask any errors you do have. ;)

Zack Barresse
01-10-2007, 04:52 PM
Also, can you post a sample of your file, or give us some examples of the data?

ska67can
01-10-2007, 08:21 PM
Try this


Option Explicit
Option Compare Text

Sub CheckNewWords()

Dim existRng As Range
Dim wordsRng As Range
Dim Rng1 As Range
Dim bMatch As Variant
Dim sht1, sht2 As Worksheet

Set sht1 = ActiveWorkbook.Worksheets("Sheet1")
Set sht2 = ActiveWorkbook.Worksheets("Sheet2")

With sht2
Set existRng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

With sht1
Set wordsRng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 3).End(xlUp))
End With

For Each Rng1 In wordsRng
With Rng1
bMatch = Application.VLookup(.Value, existRng, 1, False)
If IsError(bMatch) Then
sht2.Cells(existRng.Count + 1, 1) = .Value
With sht2
Set existRng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
End If
End With
Next

End Sub


ska

Card Maker
01-11-2007, 06:26 AM
Hi all

Thanks for the replies - sorry it was waaaaaaayy past my bedtime when you guys posted!

ska - thanks - I tried your code but it does give me a duplicate entry?:dunno

I've attached a very basic sample workbook. Input to sheet1 will be manual by the users.

Ken - either way is fine. I know how to code a command button etc!!

Thanks again for all your help!

Regards
Ann

ska67can
01-11-2007, 07:16 AM
The first few times I tried your sample, I got a duplicate with "ann" only.
I retyped "ann" in the 2 cells and had no problem. I added duplicates of the other names without any problems. I have no idea why it kept giving a duplcate for "ann". Strange that.

ska

Ken Puls
01-11-2007, 07:18 AM
Hi Ann,

Okay, two options for you here. They are both set up to use the Worksheet_Change method. Basically what this means is that each and every time ANY cell on your target sheet is changed, it will look up the value against your list. If it's there, it won't do anything, if not, it will add it.

We may want to restrict it's operating focus to a certain range of cells (not your headers, for example), or you may just want to turn off events, set those, protect them and not worry about it again. The choice there is up to you.

The code goes in the Worksheet module for the sheet you want to run it on. (Sheet1 in your example file.)

I've provided two copies. The first, which I suspect is what you'd want to use, is case insensitive. I.e. "fred" will not be added if "Fred" is in the list. The second example is case sensitive and will add "fred" if "Fred" is there.

Case insensitive version:
Private Sub Worksheet_Change(ByVal Target As Range)
'Macro purpose: To look up entered value and add it to the list if it does
'not exist.

'This is NOT case sensitive, so use if you want "fred" and "Fred" to be seen
'the same

Dim sLastLookupCell As String

'Turn off event to prevent recursive calls
On Error GoTo EarlyExit
Application.EnableEvents = False

With Worksheets("Sheet2")
'Bookmark last cell in the lookup list (make code more readable
'later only)
sLastLookupCell = .Cells(.Rows.Count, 1).End(xlUp).Address

'Check for the value.
If Application.WorksheetFunction.CountIf( _
.Range("A1:" & sLastLookupCell), Target.Value) = 0 Then
'Value not found, so add it
.Range(sLastLookupCell).Offset(1, 0) = Target.Value
Else
'Value found, so ignore it
End If
End With

EarlyExit:
'Restore events
Application.EnableEvents = True

End Sub

Case sensitive version:
Private Sub Worksheet_Change(ByVal Target As Range)
'Macro purpose: To look up entered value and add it to the list if it does
'not exist.

'This is case sensitive, so use if you want "fred" and "Fred" to be seen differently

Dim sLastLookupCell As String
Dim sVlookupResult As String

'Turn off event to prevent recursive calls
On Error GoTo EarlyExit
Application.EnableEvents = False

With Worksheets("Sheet2")
'Bookmark last cell in the lookup list (make code more readable
'later only)
sLastLookupCell = .Cells(.Rows.Count, 1).End(xlUp).Address

On Error Resume Next
'Check for the value. Error will be trapped if not found
sTemp = Application.WorksheetFunction.VLookup(Target.Value, _
.Range("A1:" & sLastLookupCell), 1, False) = True

If Error.Number <> 0 Then
'Error in lookup becaue value not in list, so add it
.Range(sLastLookupCell).Offset(1, 0) = Target.Value
Else
'Value found, so ignore it
End If
On Error GoTo EarlyExit
End With

EarlyExit:
'Restore events
Application.EnableEvents = True

End Sub

HTH,

mdmackillop
01-11-2007, 07:19 AM
Here's two separate code.
This will create an initial list of names to sheet 2
Option Explicit
Sub InitialCheck()
Dim a, d, c As Range
Dim i As Long
Set d = CreateObject("Scripting.Dictionary")
For Each c In Sheets(1).UsedRange
On Error Resume Next
d.Add c.Text, c.Text
Next
Set a = d.Items
a = d.Items
For i = 0 To d.Count - 1
Sheets(2).Cells((i + 1), 1) = a(i)
Next
End Sub





This checks new items against Sheet 2 and adds new names. Note this code must be saved in Sheet1 Worksheet module
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Set c = Sheets(2).Cells.Find(Target)
If Not c Is Nothing Then
Exit Sub
Else
Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1) = Target.Text
End If
End Sub

Ken Puls
01-11-2007, 07:43 AM
Welcome back, Malcolm! :)

mdmackillop
01-11-2007, 08:49 AM
Thanks Ken.

Card Maker
01-11-2007, 12:35 PM
Ken

That's wonderful - you are indeed a genius!!! Thanks so much!! :bow::bow:

Thank you as well Malcolm - but I've used Ken's code - sorry! :(

See you all soon! :hi:

Ann