Lionel H
10/1/2008 9:39:00 PM
"Joel" wrote:
> The code you posted ... was too hard to fix so I rewrote the code
I did the same thing, but not so quickly.
Thefollowing produces the result you are looking for with the data you
provided, but does it without using a third column. It also takes account of
your later info about three workbooks.
Sub Call_CompareAndShift()
Application.ScreenUpdating = False
Workbooks.Add
ActiveWorkbook.SaveAs "c:\bookc.xls"
Workbooks.Open "c:\booka.xls"
Workbooks("booka.xls").Worksheets(1).Range("A:A").Copy
Workbooks("bookc.xls").Activate
Sheets(1).Cells(1, 1).Select
Workbooks("bookc.xls").Sheets(1).Paste
Application.CutCopyMode = False
Application.DisplayAlerts = False
Workbooks("booka.xls").Close
Application.DisplayAlerts = True
Workbooks.Open "c:\bookb.xls"
Workbooks("bookb.xls").Worksheets(1).Range("A:A").Copy
Workbooks("bookc.xls").Activate
Sheets(1).Cells(1, 2).Select
Workbooks("bookc.xls").Sheets(1).Paste
Application.CutCopyMode = False
Application.DisplayAlerts = False
Workbooks("bookb.xls").Close
Application.DisplayAlerts = True
CompareAndShift "A:A", "B:B"
Application.ScreenUpdating = True
End Sub
Sub CompareAndShift(LRange As String, Rrange As String)
Dim aRow As Integer, bRow As Integer
Dim ShortCol As String
Dim LastRowL As Integer, LastRowR As Integer
Dim LCol As String, RCol As String
LCol = Left(LRange, 1)
RCol = Left(Rrange, 1)
Columns(LRange).Sort Key1:=Range(LCol & 1), Order1:=xlAscending
Columns(Rrange).Sort Key1:=Range(RCol & 1), Order1:=xlAscending
LastRowL = Cells(Rows.Count, LCol).End(xlUp).Row
LastRowR = Cells(Rows.Count, RCol).End(xlUp).Row
If LastRowL > LastRowR Then
bRow = LastRowL
ShortCol = RCol
Else
bRow = LastRowR
ShortCol = LCol
End If
For aRow = bRow To 1 Step -1
If Cells(aRow, LCol) = Cells(bRow, RCol) Or Cells(bRow, ShortCol) = ""
Then
'do nothing
ElseIf Cells(aRow, LCol) < Cells(bRow, RCol) Then
ShiftIt bRow, RCol, aRow, LCol
Else
ShiftIt aRow, LCol, bRow, RCol
End If
bRow = bRow - 1
Next aRow
End Sub
Sub ShiftIt(PrimaryShift As Integer, PSCol As String, SecondaryShift As
Integer, SSCol As String)
Cells(PrimaryShift, PSCol).Insert shift:=xlDown
If Cells(SecondaryShift + 1, SSCol) <> Cells(PrimaryShift + 1, PSCol) Then
Cells(SecondaryShift + 1, SSCol).Insert shift:=xlDown
Else
Cells(PrimaryShift + 2, PSCol).Delete shift:=xlUp
End If
End Sub