Maurice,
Try this. A word of explanation - 2 sheets are assumed, Master
contains the master list, and NewList contains the list you're
wanting to compare, column A of both sheets. Now here's the part
that's different. The 1st time you run this macro, in Master sheet,
column A is duplicated in column B. Column A becomes an "index"
list to keep things lined up, and column B becomes the master list.
They start of identical, but on subsequent runs the index list will
grow with every new number encountered, but your main list in column B
maintains the original entries. New lists are entered in the next
available column.
Besides the main routine (SideBySide), the function routine SheetExists
is required to test for existance of required worksheets. I know this
sounds rather convoluted, but running it will make it clear.
Dave
Sub SideBySide()
Dim rowLst1 As Integer, rowLst2 As Integer, NextCol As Integer
Dim wk1 As Worksheet, wk2 As Worksheet
rowLst1 = 1: rowLst2 = 1
' Check for necessary worksheets
If Not SheetExists("Master") Then
MsgBox ("Missing worksheet " & """Master""")
Exit Sub
ElseIf Not SheetExists("NewList") Then
MsgBox ("Missing worksheet " & """NewList""")
Exit Sub
End If
Set wk1 = Worksheets("Master"): Set wk2 = Worksheets("NewList")
' sort NewList
wk2.Select
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
wk1.Select
' sort Master and create sort index, the 1st time thru only
If ActiveSheet.UsedRange.Columns.Count = 1 Then
Range("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Range("A1").CurrentRegion.Copy Range("B1")
End If
NextCol = ActiveSheet.UsedRange.Columns.Count + 1
Range("A1").Select
With wk2
Do While Cells(rowLst1, 1) <> "" And .Cells(rowLst2, 1) <> ""
If Cells(rowLst1, 1) = .Cells(rowLst2, 1) Then
Cells(rowLst1, NextCol) = .Cells(rowLst2, 1)
rowLst1 = rowLst1 + 1
rowLst2 = rowLst2 + 1
ElseIf Cells(rowLst1, 1) < .Cells(rowLst2, 1) Then
rowLst1 = rowLst1 + 1
Else 'Cells(rowLst1,1)>.Cells(rowLst2,1)
Rows(rowLst1).Insert Shift:=xlDown
Cells(rowLst1, 1) = .Cells(rowLst2, 1)
Cells(rowLst1, NextCol) = .Cells(rowLst2, 1)
rowLst1 = rowLst1 + 1
rowLst2 = rowLst2 + 1
End If
Loop
' reached the end of Master, process remainder of NewList, if any.
Do While .Cells(rowLst2, 1) <> ""
Cells(rowLst1, 1) = .Cells(rowLst2, 1)
Cells(rowLst1, NextCol) = .Cells(rowLst2, 1)
rowLst1 = rowLst1 + 1
rowLst2 = rowLst2 + 1
Loop
End With
End Sub
Function SheetExists(ByVal SheetName As String) As Boolean
On Error GoTo NoSheet
Sheets(SheetName).Select
SheetExists = True
Exit Function
NoSheet:
SheetExists = False
End Function