Help with some VBA code Required

dmcg9760 · #1 02-19-2016, 11:02 PM

Good Morning All

I have some Excel VBA code that I require some help with.
Currently this code Color codes column's 2 To 3 ,is there a easy way to adapt code to also color code columns 10 To 16 at the same time.

Cheers
David

charlesdh · #2 02-20-2016, 12:25 PM

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

dmcg9760 · #3 02-21-2016, 03:23 AM

Hi Charlesdh

Thank you very much for the reply, it is much appreciated

I have inserted the code text into the VBA and now it only seems to mark up the first lot of data and does not continue down through the page.

I have attached a sheet for you to see the outcome results.

Kind Regards
David

charlesdh · #4 02-21-2016, 11:30 AM

Hi,

Please provide you workbook with the code.

Added:
As mentioned you will need to revamp the second loop for the desired columns.

dmcg9760 · #5 02-21-2016, 05:57 PM

Hi,
The file is quite large and I am not able to upload it on here. the file even compressed is 1.4MB, original file is 2.33MB
Do you have a email address that I can forward a link to my Dropbox shared files.

David

charlesdh · #6 02-23-2016, 06:09 PM

HI,

Sorry I have not responded. But, did you create the code? If so you may be able to look at the code I posted and make the necessary correction for your file.

dmcg9760 · #7 02-23-2016, 06:35 PM

Hi Charles

Sorry I am very new to code.

I have pasted the code in that you sent me, as requested,But the spreadsheet only color codes as per the sheet I attached.

The workbook as a whole has a lot of code that I have had written through freelancers with some very complicated formulas that are a bit beyond my ability in excel.

But I am slowly working through the issues and learning more and more all the time.

Any further help would be very much appreciated.

Cheers
David

charlesdh · #8 02-24-2016, 12:07 PM

Hi,

The code I provided seems to work. If not tell me what part of the spreadsheet did not produce the desired out come.

dmcg9760 · #9 02-26-2016, 06:21 AM

Hi Charles

It only does the first lot of data for each venue, If you look at the attached file ( Report26022016 20-39 ) from todays output you will see that in Horse Racing Tab columns J : P only the one race has been color coded instead of all down the page J:P columns,
What I am trying to get is when the runners number or name appears in column D & E the sheet also color codes down the page the same as like columns B & C like it has done in column J2:P6 but none of the rest of J:P down the page till the next venue.
Venue is in Column A : Sunshine Coast 1 , Sunshine Coast 2 and so on the next venue starts A57 : Moonee Valley 1 , Moonee valley 2 and so on down the page
Sorry hopefully that makes sense

Cheers
David

dmcg9760 · #10 03-01-2016, 03:59 PM

Good Morning Charles
Did you receive the emailed Excel file
Just following up on your thoughts about the file.
David

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Activation required, except I've already done that?	Mir	Office	1	04-01-2013 06:38 PM
Excel 2007 - formula or macro/vba code required	wrighty50	Excel Programming	3	05-13-2012 02:24 PM
What IF statement required	dr4ke	Excel	8	09-01-2011 07:41 AM
Help required with spacing	rohanmalhotra	Word VBA	3	08-11-2011 04:06 AM
Suggestion required	domex	Word	0	10-06-2010 05:35 AM