[RESOLVED] Rank - VBA

[vikasbhandari2]

Hi Experts!

I am in great trouble help me out with this.

Here is my excel sheet view

Rank Name
1 A
1 B
1 C
2 A
2 B
2 C
3 A
3 B
3 C

Question

Now I want when I run a macro I should get only Top two values from each Rank.
Example output
1 A
1 B
2 A
2 B
3 A
3 B

Could you please give me a code for this?

[Hack]

Excel VBA question moved to Office Development

[DKenny]

I should get only Top two values from each Rank.

Get them where?
Do you want the values to be

returned in an array?

written to a new worksheet?

written to the current worksheet?

[vikasbhandari2]

We can put them in new worksheet

[DKenny]

Try this

Sub TopTwo()
Dim rngData As Range
Dim asOutput() As String
Dim lRowNum As Long
Dim bOn2ndRow As Boolean
Dim wksNewSheet As Worksheet
 
    'You will need to change this line to correctly refer
    'to your data range (excluding the header row)
    Set rngData = ThisWorkbook.Worksheets(1).Range("A2:B10")
    
    'Initialize the array
    ReDim asOutput(0 To 1, 0 To 0)
    
    
    With rngData
        'Sort by Rank and then name
        .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, _
            Key2:=.Cells(1, 2), Order2:=xlAscending, _
            Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
            DataOption2:=xlSortNormal
            
        
        'load the first record into the array
        asOutput(0, 0) = .Cells(1, 1).Value
        asOutput(1, 0) = .Cells(1, 2).Value
        'note that we are next loading a "2nd" row
        bOn2ndRow = True
        
        'Loop through the rest of the rows
        For lRowNum = 2 To .Rows.Count
            
            'If the Next rank is different from the last recorded...
            If .Cells(lRowNum, 1).Value <> asOutput(0, UBound(asOutput, 2)) Then
                
                '...Add a new record to the array
                ReDim Preserve asOutput(0 To 1, UBound(asOutput, 2) + 1)
                asOutput(0, UBound(asOutput, 2)) = .Cells(lRowNum, 1)
                asOutput(1, UBound(asOutput, 2)) = .Cells(lRowNum, 2)
                
                '...and note that we are next loading a "2nd" row
                bOn2ndRow = True
                            
            'If we are loading a "2nd" Row
            ElseIf bOn2ndRow Then
                
                '...Add a new record to the array
                ReDim Preserve asOutput(0 To 1, UBound(asOutput, 2) + 1)
                asOutput(0, UBound(asOutput, 2)) = .Cells(lRowNum, 1)
                asOutput(1, UBound(asOutput, 2)) = .Cells(lRowNum, 2)
                
                '...and note that we are next loading a "1st" row
                bOn2ndRow = False
            End If
        Next lRowNum
    End With
    
    'Add a new Sheet
    Set wksNewSheet = ThisWorkbook.Worksheets.Add
    
    With wksNewSheet.Range("A1")
        'Write the Headers
        .Value = "Rank"
        .Offset(0, 1).Value = "Name"
        
        'Copy the array onto the new sheet
        For lRowNum = 0 To UBound(asOutput, 2)
            .Offset(1 + lRowNum, 0) = asOutput(0, lRowNum)
            .Offset(1 + lRowNum, 1) = asOutput(1, lRowNum)
        Next lRowNum
    End With
    
    'Clear Object variables
    Set wksNewSheet = Nothing
End Sub

[vikasbhandari2]

hey I found out...how about this :

Sub getNames()
Dim i As Integer
Dim wx As Integer
Dim nx As Integer
Dim mik As Boolean
Dim ctch As String
Dim chng As String
mik = True
 
i = 3
wx = 3
nx = 0
    While (mik)
    Range("a" & i).Select
    ctch = ActiveCell.Value
        If ctch = "" Then
        mik = False
        End If
        If chnge = ctch Then
        nx = nx + 1
        Else
        nx = 0
        End If
            If nx < 2 Then
                If ctch = "" Then
                Else
                Range("e" & wx).Select
                ActiveCell.Value = "Rank : " & ctch
                Range("f" & wx).Select
                ActiveCell.Value = Range("b" & i).Text
                wx = wx + 1
                End If
            End If
    
    
    chnge = ctch
    i = i + 1
    Wend
    
End Sub

I can see that your code is little more complex but what I want to know is that...can u find any difference in that?? If yes then i would love to know coz I cannot find any...

Not good with the excel so cant read ur code much

Thanks!!!!
Vikas Bhandari

[DKenny]

I can find lots of differences.
First off, you should avoid using the ActiveCell method whenever possible - it can lead to some really bad code. You should also avoid using the Select method.

[vikasbhandari2]

Any specific reasons?

[vikasbhandari2]

Any other thoughts that why using activecell is bad...apart of a fact that it slows down the processing time......

Thanks,Vikas

[DKenny]

Yes, it cases when you need to cede control to other processs while your code is running, by envoking DoEvents, there is the potential for the user to select a cell. This will change the activecell and your code could subsequently call the activecell, this will result in your procedure getting an incorrect value.

[vikasbhandari2]

darnnnnn..i never thought so..... yeah its right!!! Thanks for the clarification...

Regards,Vikas