Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
macro comparing two different lists
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. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
macro comparing two different lists
On Jul 31, 2:11*pm, computers hate me <computers hate
wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
macro comparing two different lists
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?. " wrote: On Jul 31, 2:11 pm, computers hate me <computers hate wrote: 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
macro comparing two different lists
On Jul 31, 3:39*pm, computers hate me
wrote: 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?. " wrote: On Jul 31, 2:11 pm, computers hate me <computers hate wrote: 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 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? |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
macro comparing two different lists
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. " wrote: On Jul 31, 3:39 pm, computers hate me wrote: 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?. " wrote: On Jul 31, 2:11 pm, computers hate me <computers hate wrote: 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 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? |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
macro comparing two different lists
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 On Aug 1, 8:34*am, computers hate me wrote: 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. " wrote: On Jul 31, 3:39 pm, computers hate me wrote: 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?. " wrote: On Jul 31, 2:11 pm, computers hate me <computers hate wrote: 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 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? |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
macro comparing two different lists
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 " wrote: 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 On Aug 1, 8:34 am, computers hate me wrote: 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. " wrote: On Jul 31, 3:39 pm, computers hate me wrote: 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?. " wrote: On Jul 31, 2:11 pm, computers hate me <computers hate wrote: 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 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? |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
macro comparing two different lists
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 On Aug 1, 12:20*pm, computers hate me wrote: 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 " wrote: 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 On Aug 1, 8:34 am, computers hate me wrote: 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. " wrote: On Jul 31, 3:39 pm, computers hate me wrote: 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?. " wrote: On Jul 31, 2:11 pm, computers hate me <computers hate wrote: 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 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? |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
macro comparing two different lists
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 to SourceSh Rng.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 On Aug 1, 12:20*pm, computers hate me wrote: 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 " wrote: 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 On Aug 1, 8:34 am, computers hate me wrote: 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. " wrote: On Jul 31, 3:39 pm, computers hate me wrote: 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?. " wrote: On Jul 31, 2:11 pm, computers hate me <computers hate wrote: 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 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? |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Comparing Lists | Excel Worksheet Functions | |||
Comparing Lists | Excel Worksheet Functions | |||
comparing lists | Excel Discussion (Misc queries) | |||
Comparing two lists | Excel Programming | |||
Comparing Lists to Partial Lists | Excel Programming |