Compare Two Lists

[S.H.A.D.O.]

Hi Everyone,

I have Two Lists.
List One ( A ) is in Cells B2:G1000.
List Two ( B ) is in Cells I2:N1250 ish.
It is to do with Pupils in a School over a Two Year Period.
List One for Arguments Sake is Year 06.
List Two for Arguments Sake is Year 07.
Some Pupils are in Year 06 but NOT in Year 07 and Vice Versa.
What I would like to do is Scatter List A & List B to be Next to Other ( in Another Sheet Named "Combined" for Example Starting in Cell B2:G? & I2:N? Whatever ) Relevant to the Pupil.
So if a Pupil is in List A ( Year 06 ) but NOT in List B ( Year 07, because they might have Left in Year 06 for Example ), Leave the Cells I:N Blank etc BUT Carry on Looking for that Particular Pupil in List A against List B until a Match is Found, if it is NOT, then List A will be Blank in Cells B:N.
It will Also Work from List B to List A.
I am Confused Trying to Explain this so I Very Much Doubt that Anyone can Possibly Understand what I am Trying to Achieve.

Any Ideas will be Very Much Appreciated.
All the Best.
SHADO

 

[tmcfadden]

Uhh... I thought my first example what what you needed.

Apparently it's not.

You should really post an example of the data you're working with.

-Tim

 

[CharlesH]

Shado,

Thought I'd try again.
If you format sheet1 with the following and run the new code it should work. The code can be cleaned up.




Col A______Col B_________________ Col D
2006______2007__________________Combined
06chris_____07john
06john______07ken
06ken_______07martha
06martha____07mike
06mary
06tim

Sub NewTry()
Application.ScreenUpdating = False
Dim lastrow, lrow, llrow As Long
Dim i As Integer
Dim SName As String
lastrow = Sheets("Sheet1").Range("A65536").End(xlUp).Row + 1
For i = 2 To lastrow
    mylen = Len(Cells(i, 1))
    mynam = Mid(Cells(i, 1), 3, mylen)
    On Error Resume Next
    Range("B:B").Find(What:=mynam, LookAt:=xlPart).Select
    If Err = "91" Then
        lrow = Sheets("Sheet1").Range("D65536").End(xlUp).Row + 1
        Cells(lrow, 4).Value = Cells(i, 1)
    Else
        lrow = Sheets("Sheet1").Range("D65536").End(xlUp).Row + 1
        Cells(lrow, 4).Value = Cells(i, 1)
        Cells(lrow, 5).Value = Cells(ActiveCell.Row, 2)
    End If
Next i
lastrow = Sheets("Sheet1").Range("B65536").End(xlUp).Row
For j = 2 To lastrow
    mylen = Len(Cells(j, 2))
    mynam = Mid(Cells(j, 2), 3, mylen)
    On Error Resume Next
    Range("A:A").Find(What:=mynam, LookAt:=xlPart).Select
    If Err = "91" Then
        lrow = Sheets("Sheet1").Range("D65536").End(xlUp).Row + 1
        llrow = Sheets("Sheet1").Range("E65536").End(xlUp).Row + 1
        If lrow > llrow Then
            Cells(lrow, 5).Value = Cells(j, 2)
        Else
            Cells(llrow, 5).Value = Cells(j, 2)
        End If
    End If
Next j

End Sub

 

[S.H.A.D.O.]

That’s Brilliant CharlesH, thank you.
It Works Perfectly if there were Only the Usernames.
Now the Only thing Left to do is to Incorporate into the Code the Actual Ranges of List A & List B.
List A is the Range B:G & List B is the Range I:N.

For Example in List A …

Cells B has the Username
Cells C has the Surname
Cells D has the Christian Name
Cells E:G has Other Information

… and Cells I:N in List B has the Same Information.

So the New List A will be in Cells P:U and the New List B will be in Cells W:AB.

Thanks Again in Advance.
All the Best.
SHADO

 

[CharlesH]

Shado,


See if the following code works.

Sub NewTry2()
Application.ScreenUpdating = False
Dim lastrow, lrow, llrow As Long
Dim i As Integer
Dim SName As String
lastrow = Sheets("Sheet1").Range("B65536").End(xlUp).Row + 1
For i = 2 To lastrow
    mylen = Len(Cells(i, 2))
    mynam = Mid(Cells(i, 2), 3, mylen)
    On Error Resume Next
    Range("I:I").Find(What:=mynam, LookAt:=xlPart).Select
    If Err = "91" Then
        lrow = Sheets("Sheet1").Range("P65536").End(xlUp).Row + 1
       Range(Cells(i, 2), Cells(i, 7)).Copy Destination:=Cells(lrow, 16)
    Else
        lrow = Sheets("Sheet1").Range("P65536").End(xlUp).Row + 1
        Range(Cells(i, 2), Cells(i, 7)).Copy Destination:=Cells(lrow, 16)
        Range(Cells(ActiveCell.Row, 9), Cells(ActiveCell.Row, 14)).Copy Destination:=Cells(lrow, 23)
    End If
Next i
lastrow = Sheets("Sheet1").Range("I65536").End(xlUp).Row
For j = 2 To lastrow
    mylen = Len(Cells(j, 9))
    mynam = Mid(Cells(j, 9), 3, mylen)
    On Error Resume Next
    Range("B:B").Find(What:=mynam, LookAt:=xlPart).Select
    If Err = "91" Then
        lrow = Sheets("Sheet1").Range("P65536").End(xlUp).Row + 1
        llrow = Sheets("Sheet1").Range("w65536").End(xlUp).Row + 1
        If lrow > llrow Then
            Range(Cells(j, 9), Cells(j, 14)).Copy Destination:=Cells(lrow, 23)
        Else
             Range(Cells(j, 9), Cells(j, 14)).Copy Destination:=Cells(llrow, 23)
        End If
    End If
Next j

End Sub

 

[S.H.A.D.O.]

Outstanding CharlesH,

I Can't Thank You Enough.
That will Save me SOOOOO Much Time.
I will go through the Code and Try & Work Out what Each Piece is Doing.

Have a Great Day!.
All the Best.
SHADO

 

[CharlesH]

Shado,

Thanks for letting me know.