Match, Sort unique list

[Mut]

Dear all,
I am a newcomer here and newbie in VBA. My problem is;
I have sheet 1
Column A (not sorted by name, could be more than 50 name in unique
list)
EXTRA
TAU
HID
..etc

and I have sheet 2
Column A (not sorted by name, could be vary)
EXTRA
EXTRA
TAU
TAU
HID
EXTRA
HID
..etc

I want to sort sheet 2 by 'unique list' sheet 1.
So it could be,
EXTRA
EXTRA
EXTRA
TAU
TAU
HID
HID

Thanks for your help..

 

[Executor]

Hi Mut,

I use a other method.
I create a new sheet and copy - paste to this new sheet.
I assume that there are columnheadings on your Sheet2
so I copy these to the new sheet

I use Autofilter to copy asubset from sheet2 to the new sheet.
In the end I rename both Sheet2 and the new sheet

This is my code:

Sub SpecialSortOnSheet2()
'
'
' The macro is created on 19-1-2006 by Executor
'

'
Dim strName As String
Dim strUsed As String

Sheets("Sheet2").Select

strUsed = ActiveSheet.UsedRange.Address
If Not IsEmpty(Range("A2")) Then
Range(Range("A1"), Range("A1").End(xlToRight)).Select
Else
Range("A1").Select
End If
strUsed = "A2:" &
ActiveCell.SpecialCells(xlCellTypeLastCell).Address

Selection.Copy
Sheets.Add
ActiveSheet.Name = "Sheet2_target"
Range("A1").Select
ActiveSheet.Paste

Sheets("Sheet2").Select
Selection.AutoFilter

Sheets("Sheet1").Select
Range("A2").Select
Do While Not IsEmpty(ActiveCell)
strName = ActiveCell.Value
Sheets("Sheet2").Select
Selection.AutoFilter Field:=1, Criteria1:=strName
Range(strUsed).Select
Selection.Copy
Sheets("Sheet2_target").Select
If IsEmpty(Range("a2")) Then
Range("A2").Select
Else
Range("A1").End(xlDown).Offset(1, 0).Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Sheet1").Select
ActiveCell.Offset(1, 0).Select
Loop
Application.CutCopyMode = False
Sheets("Sheet2").Name = "Sheet2_unsorted"
Sheets("Sheet2_unsorted").Visible = False
Sheets("Sheet2_target").Name = "Sheet2"
End Sub

Hoop this helps,

Executor

 

[Mut]

Thanks!!!
It works.. :