Tan,

I love a challenge! I am not an "expert" in Excel, and I am sure some
of my methods of doing things could be done by some much easier than I
make them, but!!!

I wrote this macro, and it does what you want. You may have to modify
some things. Here are the assumptions I made from what you wrote:

1. You have data on two worksheets. (my macro uses sheet1 and sheet2.
You'll have to change them to suit your workbook)
2. There is only data in columns A and B in each worksheet.
3. There are 200 company names listed in column A on sheet2. (if there
are more, you'll have to modify the macro, and replace the "201" values
to however many companies are listed +1)
4. There are several thousand companies listed in column A on sheet 1.
In my example, I used 2000. Replace all references to "2001" with
whatever is the case on your sheet1. (# of companies +1)

You will have to prep the sheet by naming some ranges:

1. Name the range A2:B201 on sheet2 "bothcolumns" (unless you have more
than 200 companies...then of course, modify the range to fit your
case.)
2. Name the range A2:A201 on sheet2 "firstcolumn" (again, make the
actual range fit your case)

Put the macro in a module, and run it.

==========copy start============

Sub sortdata()
Dim x As Integer
Sheets("sheet2").Select
Range("bothcolumns").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlDescending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("Sheet1").Select
Cells(2, 3).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],bothcolumns,2,FALSE)"
Selection.AutoFill Destination:=Range("C2:C2001"), Type:=xlFillDefault
Range("C2:C2001").Select
Selection.Copy
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="#N/A", Replacement:="delete", LookAt:=xlPart,
_
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
Cells(2, 3).Select
For x = 1 To 2000
If ActiveCell.Text = "delete" Then
Selection.EntireRow.Delete
If ActiveCell.Text = "delete" Then
ActiveCell.Offset(-1, 0).Select
Else
End If
Else
End If
ActiveCell.Offset(1, 0).Select
Next x
Range("C2").Select
ActiveCell.FormulaR1C1 = "=MATCH(RC[-2],firstcolumn,0)"
Selection.AutoFill Destination:=Range("C2:C201"), Type:=xlFillDefault
Range("C2:C201").Select
Selection.Copy
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
Range("A2:C26").Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
End Sub

========copy stop========
I really hope it works! I tried it out here, and got what I think you
want!

Please let me know.

Kevin


--
kevindmorgan
------------------------------------------------------------------------
kevindmorgan's Profile: http://www.excelforum.com/member.php...o&userid=32232
View this thread: http://www.excelforum.com/showthread...hreadid=520410