+ Reply to Thread
Results 1 to 3 of 3

Match, Sort unique list

  1. #1
    Registered User
    Join Date
    01-19-2006
    Posts
    28

    Match, Sort unique list

    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..

  2. #2
    Executor
    Guest

    Re: Match, Sort unique list

    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


  3. #3
    Registered User
    Join Date
    01-19-2006
    Posts
    28

    Special Sort

    Thanks!!!
    It works..

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1