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

 

[tusharm]

Ummm...let's see...enter formula in one cell, select cell, scroll down using vertical scrollbar, SHIFT+click in the last cell of interest, CTRL+D to duplicate formula in top cell.

Hi Everyone,

The Reason I would like Code to do this is because it will take MANY Hours to Insert Cells Down ( in BOTH Lists ) so that Both Lists Tie Up to the Username.

Thanks in Advance.
All the Best.
SHADO

 

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

Hi tusharm,

Thanks for the Reply,

I think what is Confusing the Issue is that for EACH List there are 6 Entries.

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.

I Hope this Explains it a Bit Clearer.

Thanks in Advance.
All the Best.
SHADO

 

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

Hi Again,

Does Anybody know of Someone who has done Something Similar to this that I might be Able to Adapt Please.

Thanks in Advance.
All the Best.
SHADO

 

[CharlesH]

Shado,

The following I used Column "A" for 2006 and Column "B" for 2007.
COlumn "D" for the combined.
I used the sample info provided by "tmcfadden" and the same format.
The following code should produce the same results as in tmcfadden example. If this works you can then expand it to your needs.
Copy this to a module.

Sub Cmpre()
Application.ScreenUpdating = False
Dim rngA As Range
Dim rngB As Range
Dim Cell
Dim lastrow As Long
Set rngA = Sheets("Sheet1").Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
Set rngB = Sheets("Sheet1").Range(Cells(2, 2), _
Cells(Rows.Count, 2).End(xlUp))
For Each Cell In rngA
    If Application.CountIf(rngB, Cell.Value) = 0 Then
        lastrow = Worksheets("sheet1").Range("d65536").End(xlUp).Row + 1
            Cells(Cell.Row, 1).Copy Destination:=Worksheets("Sheet1").Range("D" & lastrow)
        ElseIf Application.CountIf(rngB, Cell.Value) = 1 Then
            lastrow = Worksheets("sheet1").Range("d65536").End(xlUp).Row + 1
            Cells(Cell.Row, 1).Copy Destination:=Worksheets("Sheet1").Range("D" & lastrow)
            Cells(lastrow + 1, 5) = Cell.Value
        End If
    Next
    For Each Cell In rngB
        If Application.CountIf(rngA, Cell.Value) = 0 Then
            lastrow = Worksheets("sheet1").Range("d65536").End(xlUp).Row + 1
            Cells(Cell.Row, 2).Copy Destination:=Worksheets("Sheet1").Range("E" & lastrow)
        End If
    Next
End Sub

 

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

Thanks for the Reply CharlesH,

Unfortunately this does Not Work.
It does Not put a Gap in Either List A or List B so is Still out of Sync.
If this Code Worked I think I Might be Able to Adapt it to my Needs.
The New List Looks like this :-

2006 2007
chris, john, chris, blank,
john, ken, john, blank,
ken, martha, ken, john,
martha, mike, martha, ken,
mary, mary, mary, martha,
tim, mike, tim, mary,
blank, blank, blank, mike,

Thanks in Advance.
All the Best.
SHADO

 

[Rastaman]

Just my 2 cents worth. I've had similar tasks and I solved them by adding a column to the left of each of the data sets, in your case call it YEAR. For each of the lists copy down the entire list with the appropriate year. Then append the two lists together. This of course assumes the two lists have the same number and type of columns. Then you can pivot table the data. However, seems like you would want to concatenate the names into a single cell.

Rick

 

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

Thanks for the Reply Rastaman,

I do Not want to Concatenate Any Cells.
CharlesH Code is along the Right Lines if it was to Produce the Correct Results in that Format.
I think I Might be Able to Adapt that Code ( for the Extra Data in the Other Columns for List A & List B ) to my Needs if it was to Produce the Correct Results.

Thanks Again.
All the Best.
SHADO

 

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

I have tried Adapting CharlesH Code but to NO Avail.

All the Best.
SHADO

 

[tmcfadden]

Here's my try at it.

First I put all the names together, perform a bubblesort, insert that list to a new worksheet, and then file down through the new list moving the names accordingly.

This was based on my example, however. It now appears that there's more to it.

-Tim

Sub BubbleSort(List() As String)
'   Sorts an array using bubble sort algorithm

    Dim First As Integer, Last As Integer
    Dim i As Integer, j As Integer
    Dim Temp As String
   
    First = LBound(List)
    Last = UBound(List)
    For i = First To Last - 1
        For j = i + 1 To Last
            If List(i) > List(j) Then
                Temp = List(j)
                List(j) = List(i)
                List(i) = Temp
            End If
        Next j
    Next i
   
   'Reference: http://www.lacher.com/examples/lacher17.htm
End Sub

Sub ArrangeLists()
Dim shtOriginal As Worksheet, shtNew As Worksheet, rngNewListTopLeftCell As Range
Dim rngYear1 As Range, rngYear2 As Range, rngFound As Range
Dim strArray() As String
Dim iCount As Integer
Dim bYear1 As Boolean, bYear2 As Boolean

'==================================================
'Set the values accordingly
Set shtOriginal = Worksheets(1)
Set shtNew = Worksheets(2)

Set rngYear1 = shtOriginal.Range("D9:D14")
Set rngYear2 = shtOriginal.Range("E9:E14")

Set rngNewListTopLeftCell = shtNew.Range("A1")
'==================================================

shtOriginal.Activate
iCount = Application.WorksheetFunction.CountA(Range(rngYear1.Address, rngYear2.Address))
ReDim strArray(1 To iCount)

iCount = 0
For Each cell In Range(rngYear1.Address, rngYear2.Address)
    If (cell.Value <> "") Then
        iCount = iCount + 1
        strArray(iCount) = cell.Value
    End If
Next cell

BubbleSort strArray

iCount = 0
For Each st In strArray
    rngNewListTopLeftCell.Offset(iCount) = st
    iCount = iCount + 1
Next st

iCount = 1
For iCount = 1 To shtNew.Range("A1", shtNew.Range("A1").End(xlDown)).Cells.Count
    If (shtNew.Range("A1").Offset(iCount - 1) = "") Then Exit For
    
    bYear1 = False
    bYear2 = False
    
    Set rngFound = rngYear1.Find(shtNew.Range("A1").Offset(iCount - 1))
    If (TypeName(rngFound) <> "Nothing") Then
        'Had to add this due to an odd bug
        If (rngFound = shtNew.Range("A1").Offset(iCount - 1)) Then
            bYear1 = True
        End If
    End If
    
    Set rngFound = rngYear2.Find(shtNew.Range("A1").Offset(iCount - 1))
    If (TypeName(rngFound) <> "Nothing") Then
        If (rngFound = shtNew.Range("A1").Offset(iCount - 1)) Then
            bYear2 = True
        End If
    End If

    If (bYear1 = True And bYear2 = False) Then
        'Year 1 only, do nothing
    Else
    If (bYear1 = True And bYear2 = True) Then
        'Both years, move the next value up to next column
        rngNewListTopLeftCell.Offset(iCount - 1).Copy rngNewListTopLeftCell.Offset(iCount - 1, 1)
        rngNewListTopLeftCell.Offset(iCount).Delete xlShiftUp
        'iCount = iCount - 1
    Else
    If (bYear1 = False And bYear2 = True) Then
        'Only year two, move the current cell over & leave a blank
        rngNewListTopLeftCell.Offset(iCount - 1).Copy rngNewListTopLeftCell.Offset(iCount - 1, 1)
        rngNewListTopLeftCell.Offset(iCount - 1).Clear
    End If
    End If
    End If

Next iCount

End Sub

 

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

Thanks for the Time & Effort you have put into this tmcfadden,

I have Managed to get it to Work on the Initial Data.
There is a Unique Student ID Number being the Username, Lets Say in List A & List B.
For Example, the Username of 06handg, is made up of the Year ( 06 ), the First 4 Letters of their Surname ( hand ) and the First Letter of their Christian Name.
The Username will Only Change when the Student goes up a Year. For Example, the Student Username 06handg ( Year 06 ) will Become Student Username 07handg ( Year 07 ).
The only thing being the Student might NOT be in Year 06 but Started Sometime in Year 07. Also a Student might Leave in Year 06 so will NOT be there in Year 07. That is Why there will be Blank Cells Incorporated in BOTH Lists.
If the Student is in BOTH Years then the 07handg in List B will be Directly Next to 06handg in List A etc.
Your Code Works if I Use the Christian Name or Surname. If I Use the Username it Doesn't Start List B Until the Last Entry in List A.

Thanks Again in Advance.
All the Best.
SHADO