Alphabetically Order list

**rizmomin** · 04-14-2010, 02:57 PM

Please refer to attached excel sheet.

I need a VB Macro to perform following task..

Sheet1 column 1 shows Company names....some companies listed multiple times
From here i wanted to create alphabetically Company names listed once...in Column 2

Let me know if you have any questions.

Looking forward for the solutions and always appreciate your help.

Thank you

Riz Momin

**contaminated** · 04-14-2010, 03:31 PM

if I understant u properly u wanna get unique values in column B.... so u can use advanced filter option...
http://office.microsoft.com/en-us/excel/HP100739431033.aspx"]See how to get unique values with advanced filter[/URL]

**rizmomin** · 04-14-2010, 03:58 PM

No ...

First it needs to delete all blank rows.
Then delete duplicate company names ( 1 entry stays)
Then sort Alphabetically...

The above needs to be done thru Macro...so please help

Thank U

Riz

**contaminated** · 04-15-2010, 12:10 PM

Ok. Try this Macro

Sub Tesr()
    Dim LastRow As Long, j As Long
    Dim MyRange As Range, Cell As Range
    
    With Range("A:A")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    Set MyRange = Range("A1:A" & LastRow)

    Application.ScreenUpdating = False
    
'   Deleting dublicates and blang rows
    For j = LastRow To 1 Step -1
        With WorksheetFunction
            If .CountIf(Range("A1:A" & j), Range("A" & j)) > 1 Or _
                    Range("A" & j).Value = "" Or _
                    Len(Range("A" & j)) = 1 Then
                Rows(j).Delete
            End If
        End With
    Next j
    
    LastRow = Range("A1").End(xlDown).Row
    Set MyRange = Range("A1:A" & LastRow)
    
    MyRange.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
    With Range("A1")
        .Interior.Color = 65535
        .Font.Bold = True
        .Font.Color = -16776961
        .EntireColumn.AutoFit
        .Select
    End With

    Application.ScreenUpdating = True
End Sub