View Single Post
 
Old 02-20-2016, 12:25 PM
charlesdh charlesdh is offline Windows 7 32bit Office 2010 32bit
Expert
 
Join Date: Apr 2014
Location: Mississippi
Posts: 382
charlesdh is on a distinguished road
Default

Hi,

I add another loop for columns 10 to 16. You may need to review it. I did not check to see if the loop I added needed to be changed in any way.

Code:
Sub MarkWinners(ws As Worksheet)

    Dim l_row As Long

    

    With ws

        .Columns("D:D").NumberFormat = "General"

        .Columns("G:G").NumberFormat = "General"

        .Columns("I:I").NumberFormat = "General"

        For col = 2 To 3

         l_row = .Cells(.Rows.Count, col).End(xlUp).Row

            r = 3

            Do While r <= l_row

                ref_row = r

                win1 = .Range("E" & ref_row)

                'Find 4th

                pl4 = 0

                For rWinner = ref_row To ref_row + 8

                    If InStr(1, .Range("E" & rWinner), "*") > 0 Then

                        pl = Split(.Range("E" & rWinner), "*")

                        If UBound(pl) >= 3 Then

                            pl4 = Val(pl(3))

                            Exit For

                        End If

                    End If

                Next rWinner

                

                If win1 = "" Then

                    r = r + 9

                Else

                    

                    win2 = .Range("E" & ref_row + 1)

                    win3 = .Range("E" & ref_row + 2)

                    

                    r_runner = r

                    On Error Resume Next

                    Do While Not IsEmpty(.Cells(r_runner, col))

                        If Not IsError(.Cells(r_runner, col)) Then

                            If InStr(1, .Cells(r_runner, col), win1) > 0 Then

                                .Cells(r_runner, col).Interior.Color = RGB(148, 208, 80)   'Green

                            ElseIf InStr(1, .Cells(r_runner, col), win2) > 0 Then

                                .Cells(r_runner, col).Interior.Color = RGB(255, 192, 0)    'Amber

                            ElseIf InStr(1, .Cells(r_runner, col), win3) > 0 Then

                                .Cells(r_runner, col).Interior.Color = RGB(255, 0, 0)      'Red

                            ElseIf Val(Left(.Cells(r_runner, col), 2)) = pl4 Then

                                .Cells(r_runner, col).Interior.Color = RGB(0, 176, 240)    'Blue

                            End If

                        End If

                        r_runner = r_runner + 1

                    Loop

                    r = r_runner + 1

                End If

            Loop

        Next col
        '''''''''''''''''''  New Loop for column 10 to 16 '''
For col = 10 To 16

         l_row = .Cells(.Rows.Count, col).End(xlUp).Row

            r = 3

            Do While r <= l_row

                ref_row = r

                win1 = .Range("E" & ref_row)

                'Find 4th

                pl4 = 0

                For rWinner = ref_row To ref_row + 8

                    If InStr(1, .Range("E" & rWinner), "*") > 0 Then

                        pl = Split(.Range("E" & rWinner), "*")

                        If UBound(pl) >= 3 Then

                            pl4 = Val(pl(3))

                            Exit For

                        End If

                    End If

                Next rWinner

                

                If win1 = "" Then

                    r = r + 9

                Else

                    

                    win2 = .Range("E" & ref_row + 1)

                    win3 = .Range("E" & ref_row + 2)

                    

                    r_runner = r

                    On Error Resume Next

                    Do While Not IsEmpty(.Cells(r_runner, col))

                        If Not IsError(.Cells(r_runner, col)) Then

                            If InStr(1, .Cells(r_runner, col), win1) > 0 Then

                                .Cells(r_runner, col).Interior.Color = RGB(148, 208, 80)   'Green

                            ElseIf InStr(1, .Cells(r_runner, col), win2) > 0 Then

                                .Cells(r_runner, col).Interior.Color = RGB(255, 192, 0)    'Amber

                            ElseIf InStr(1, .Cells(r_runner, col), win3) > 0 Then

                                .Cells(r_runner, col).Interior.Color = RGB(255, 0, 0)      'Red

                            ElseIf Val(Left(.Cells(r_runner, col), 2)) = pl4 Then

                                .Cells(r_runner, col).Interior.Color = RGB(0, 176, 240)    'Blue

                            End If

                        End If

                        r_runner = r_runner + 1

                    Loop

                    r = r_runner + 1

                End If

            Loop

        Next col
    End With
End Sub
Reply With Quote