macro comparing two different lists

[computers hate me]

I have two sheets i havea column of set names in sheet 1 column A and Sheet
2 has another list of names in column B.
I need a macro that compares both lists. If one of the names in Sheet2
Column B is not found in sheet 1 column A place that name in sheet 1 column B.

 

[sbitaxi]

I have two sheets i havea  column of set names in sheet 1 column A and Sheet
2 has another list of names in column B.
I need a macro that compares both lists. If one of the names in Sheet2
Column B is not found in sheet 1 column A place that name in sheet 1 column B.

Try this. Did you mean that you wanted the missing name appended to
the end of the list in Sheet2 Column B or into Sheet1 Column B? Right
now, the code drops it into Sheet2.

Sub CompareNames()
Dim MyCell As Range
Dim WS As Worksheet
Dim WS2 As Worksheet
Dim FoundCell As Range
Dim LRow As Integer
Dim LRow2 As Integer
Dim FndRange As Range

Set WS = Sheets("Sheet1")
Set WS2 = Sheets("Sheet2")
LRow = WS.Cells(Rows.Count, "A").End(xlUp).Row
LRow2 = WS2.Cells(Rows.Count, "B").End(xlUp).Row
WS2.Activate

For Each MyCell In WS.Range("A1:A" & LRow)
Range("B:B").Select
Set FoundCell = Cells.Find(What:=MyCell.Value, _
After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If FoundCell Is Nothing Then
WS2.Range("B" & LRow + 1).Value = MyCell.Value
LRow2 = LRow2 + 1
End If
Next
End Sub

 

[computers hate me]

sorry but yes i would actually like for the new alarms to be apended to the
bottom of my list in sheet one because this is the "master list of names"
this is why i want to get any new names apended to this list.

Ok well i ran the macro just how you sent it to me and nothing happened?
None of the new names where apended to sheet two.

Does the range have to do with this? because the "master list" in sheet one
is only about 710 names but the one where im looking for new names is about
35,000 names?.

 

[sbitaxi]

sorry but yes i would actually like for the new alarms to be apended to the
bottom of my list in sheet one because this is the "master list of names"
this is why i want to get any new names apended to this list.

Ok well i ran the macro just how you sent it to me and nothing happened?
None of the new names where apended to sheet two.

Does the range have to do with this? because the "master list" in sheet one
is only about 710 names but the one where im looking for new names is about
35,000 names?.

It may have to do with Integer, as it has a maximum of 32,767,
switching it to Long will correct that.

If the new names are already entered into sheet 1, how can they be
appended to the source? This will cause a loop. Where are the new
values first added? I assumed that you were putting those new values
into Sheet1 ColumnA.

Are the values in Sheet2 Column B unique or do they appear multiple
times in that list?

 

[computers hate me]

Ok sorry i dont think i explained myself to clearly.

Ok so in sheet 1 i have a list of "master names" which is about 700 names

Then sheet two has the names of people who have done certain trainings. some
of these people do more thatn one training so their name can repeat many
times in sheet 2. There are also some new people that appear in sheet 2 that
are not in the "Master List" yet. So i want to be able to identify these new
names in sheet 2 and then attach these new names to the bottom of
the"master list" in sheet one.

 

[sbitaxi]

Alright, that makes sense. This should do it for you.

Sub CompareNames()
Dim MyCell As Range
Dim DestSh As Worksheet
Dim SourceSh As Worksheet
Dim FilterSh As Worksheet
Dim FoundCell As Range
Dim LRow As Long
Dim LRow2 As Long
Dim LRow3 As Long
Dim FndRange As Range
Dim Rng As Range

'* Disable Screen updating, calculations and anything else that might
slow down macro processing
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.StatusBar = "Compiling names list, please be patient!"
End With

' Declares variables
Set DestSh = Sheets("Sheet1")
Set SourceSh = Sheets("Sheet2")
Set FilterSh = Worksheets.Add
LRow = DestSh.Cells(Rows.Count, "A").End(xlUp).Row
LRow2 = SourceSh.Cells(Rows.Count, "B").End(xlUp).Row
Set Rng = SourceSh.Range("B1:B" & LRow2)

With FilterSh
'first we copy the Unique data from the filter field to
SourceSh
Rng.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), Unique:=True
End With
LRow3 = FilterSh.Cells(Rows.Count, "A").End(xlUp).Row
DestSh.Activate

For Each MyCell In FilterSh.Range("A1:A" & LRow2)
Range("A:A").Select
Set FoundCell = Cells.Find(What:=MyCell.Value, _
After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If FoundCell Is Nothing Then
DestSh.Range("a" & LRow + 1).Value =
MyCell.Value
LRow = LRow + 1
End If
Next
Application.DisplayAlerts = False
FilterSh.Delete
Application.DisplayAlerts = True
With Application
.ScreenUpdating = True
CalcMode = .Calculation
.Calculation = xlCalculationAutomatic
.StatusBar = False
End With

End Sub

 

[computers hate me]

when i try to run the macro an error box come up
that says
error'438'
obeject doesnt support this property or method

when i click od debug it takes me to

SourceSh

 

[sbitaxi]

It has to do with your Sheet Names, change "Sheet1" and "Sheet2" to
match the name of your Sheets. "Sheet2" is the name of the sheet
containing your large list and "Sheet1" is your master list with the
unique names. FilterSh is dynamic and set by the code so you can leave
that.


Steven

 

[sbitaxi]

Wait...which "SourceSh" line? If you copied it exactly, then it's
probably a wrapping issue right here -

With FilterSh
'first we copy the Unique data from the filter field toRng.Columns(1).AdvancedFilter _

One last time, here is the code:

Sub CompareNames()
Dim MyCell As Range
Dim DestSh As Worksheet
Dim SourceSh As Worksheet
Dim FilterSh As Worksheet
Dim FoundCell As Range
Dim LRow As Long
Dim LRow2 As Long
Dim LRow3 As Long
Dim FndRange As Range
Dim Rng As Range

'* Disable Screen updating, calculations and anything else that might
slow down macro processing
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.StatusBar = "Compiling names list, please be patient!"
End With

' Declares variables
Set DestSh = Sheets("Sheet1")
Set SourceSh = Sheets("Sheet2")
Set FilterSh = Worksheets.Add
LRow = DestSh.Cells(Rows.Count, "A").End(xlUp).Row
LRow2 = SourceSh.Cells(Rows.Count, "B").End(xlUp).Row
Set Rng = SourceSh.Range("B1:B" & LRow2)

With FilterSh
'first we copy the Unique data from the filter field to
SourceSh
Rng.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), Unique:=True
End With
LRow3 = FilterSh.Cells(Rows.Count, "A").End(xlUp).Row
DestSh.Activate

For Each MyCell In FilterSh.Range("A1:A" & LRow2)
Range("A:A").Select
Set FoundCell = Cells.Find(What:=MyCell.Value, _
After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If FoundCell Is Nothing Then
DestSh.Range("a" & LRow + 1).Value =
MyCell.Value
LRow = LRow + 1
End If
Next

Application.DisplayAlerts = False
FilterSh.Delete

With Application
.DisplayAlerts = True
.ScreenUpdating = True
CalcMode = .Calculation
.Calculation = xlCalculationAutomatic
.StatusBar = False
End With

End Sub