Repeating Code x Number of Times

[Ark68]

I have this code which sorts a dynamic range of data.

Sub sort()

    With Sheets("RPL") '(arr(g))

        Dim lRowst As Long
        Dim lRowed As Long
        Dim vg As String
    
           
        llastrow = .Range("R" & Rows.Count).End(xlUp).Row
        Set rdata = .Range("R13:R" & llastrow)
    
        vg = "DT"
    
        cntdr = Application.CountIf(rdata, vg)
    
        If cntdr > 0 Then 'there are DRs
            
            On Error Resume Next
            lRowst = Application.Match(vg, rdata, 0)
            On Error GoTo 0
            
            lRowst = lRowst + 12
            lRowed = lRowst + cntdr - 1
               
            Set oRangeSort = .Range("A" & lRowst & ":R" & lRowed)
            oRangeSort.sort key1:=Range("B" & lRowst), order1:=xlAscending, key2:=Range("Q" & lRowst), order2:=xlDescending, Header:=xlNo, _
                    OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
                    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        Else
            MsgBox "No"
        End If
    End With

End Sub

It is written to only work with one criteria (vg) ... DT. I need to repeat this code another 5 different criteria (vg = DR, DTR, FT, FR).
How can I do this without having to repeat the code 5 times. I simply need to change the variable vg to do this.

 

[s hal]

You could feed the 5 different values into an array and loop on the array index - not sure if there is a more elegant solution, however.

 

[Ark68]

Hi s hal ... I forgot about the use of arrays. I will try that. Thanks for sparking some creativity!
As far as elegance, not a requirement ... none of the rest of my application is.

 

[doofusboy]

One way to do this would be to wrap the code you want to repeat in a FOR loop, something like this:

Sub sort()
    With Sheets("RPL") '(arr(g))
        Dim lRowst As Long
        Dim lRowed As Long
        Dim vg As String
        [COLOR=#ff0000][B]Dim intCounter As Integer
[/B][/COLOR]          
        [COLOR=#ff0000][B]For intCounter = 1 To 5
[/B][/COLOR]           llastrow = .Range("R" & Rows.Count).End(xlUp).Row
            Set rdata = .Range("R13:R" & llastrow)
            
[COLOR=#ff0000][B]           Select Case intCounter
                Case 1
                    vg = "DT"
                Case 2
                    vg = "DR"
                Case 1
                    vg = "DTR"
                Case 2
                    vg = "FT"
                Case 1
                    vg = "FR"
            End Select
[/B][/COLOR]           
            cntdr = Application.CountIf(rdata, vg)
        
            If cntdr > 0 Then 'there are DRs
                
                On Error Resume Next
                lRowst = Application.Match(vg, rdata, 0)
                On Error GoTo 0
                
                lRowst = lRowst + 12
                lRowed = lRowst + cntdr - 1
                   
                Set oRangeSort = .Range("A" & lRowst & ":R" & lRowed)
                oRangeSort.sort key1:=Range("B" & lRowst), order1:=xlAscending, key2:=Range("Q" & lRowst), order2:=xlDescending, Header:=xlNo, _
                        OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
                        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
            Else
                MsgBox "No"
            End If
        [COLOR=#ff0000][B]Next intCounter[/B][/COLOR]
    End With
End Sub

 

[s hal]

I like the Select Case solution! MUCH more elegant than what I was thinking - I knew there had to be a more elegant solution!