VBA to colour a cell based on data in 2 others cells

H

honkin

Active Member
Joined
Mar 20, 2012
Messages
374
Office Version
  1. 2016
Platform
  1. MacOS
I was asked to repost this question again, so here goes.

How is it possible to format the contents in one column (E), based on the data in 2 other columns (A & C)?

Here is an example of what might be in A & C

A - LTD1
C can have around 20 different leagues. Here's an example
Austria: 2. Liga
Australia: A-League
Bulgaria: Parva Liga
Czech Republic: Czech Liga
Denmark: Superliga
Germany: Bundesliga II
Greece: Superleague
Hungary: NB I
Portugal: Primeira Liga
Portugal: Segunda Liga
Poland: Ekstraklasa
Qatar: Q League
Turkey: Super Lig

What I want is the ability to have the corresponding cell in E change colour based on what shows in A & C

So let's say A10 is LTD1 and C10 is Hungary: NB I, I would want E10 to turn green (RGB 146, 208, 79 which is Hex #92D04F). Since it will not be just a single entry, I assumed just using Conditional Formatting was not an option, but rather VBA.

Predictology-Reports Football Advisor.xlsx
ABCDE
2923LTD2_HOME13/09/2022 18:15Qatar: Premier LeagueLayDrawAl Gharafa - Al Markhiya
2924LTD3_AWAY13/09/2022 18:15Qatar: Premier LeagueLayDrawAl Gharafa - Al Markhiya
2925LTD2_AWAY13/09/2022 19:45England: League OneLayDrawIpswich - Bristol Rvs
2926LTD2_AWAY13/09/2022 19:45England: League OneLayDrawPeterboro - Fleetwood Town
2927LTD2_HOME13/09/2022 19:45England: League OneLayDrawWycombe - Accrington
2928MARIA1_ALTERNATE_HOME_SUMMER14/09/2022 11:00Japan: J1 LeagueLayDrawKyoto Sanga - Yokohama F. Marinos
2929LTD2_HOME14/09/2022 20:00England: ChampionshipLayDrawWest Brom - Birmingham
2930MARIA1_ALTERNATE_AWAY_SUMMER15/09/2022 00:00Uruguay: Primera DivisionLayDrawNacional - Boston River
2931MARIA1_ALTERNATE_HOME_SUMMER15/09/2022 00:00Uruguay: Primera DivisionLayDrawNacional - Boston River
2932LTD1_HOME_SUMMER16/09/2022 16:00Lithuania: A LygaLayDrawKauno Zalgiris - Jonava
2933LTD1_HOME16/09/2022 17:30Bulgaria: Parva LigaLayDrawCSKA 1948 Sofia - Septemvri Sofia
2934LTD6_HOME16/09/2022 18:00Germany: 3. LigaLayDrawMunich 1860 - Erzgebirge Aue
2935LTD2_AWAY16/09/2022 18:30France: NationalLayDrawDunkerque - Cholet
2936MARIA1_ALTERNATE_AWAY16/09/2022 18:30France: NationalLayDrawDunkerque - Cholet
2937LTD4_HOME16/09/2022 19:00NL: Eerste DivisieLayDrawZwolle - Den Haag
Lay The Draw


As indicated, there are maybe 20 leagues just for LTD1. The LTD entries in A go from LTD1 to LTD6, with each having their own set of leagues. Happy to just deal with getting LTD1 right for now, as I can adjust the VBA macro accordingly to create the additional ones required.

So the basic aim is if A contains LTD1 and C contains even just the leagues above, how would I code having E turn green?

Thanks in advance
 
Sort by date Sort by votes
I understand that data used for the decision are in columns A & C.

I don't mean to argue on the list but do you really want to go into code to change the list of leagues each time that leagues for a system change? The approach I imagine -- with lists -- would make coding that you want easy and would make it easier to make changes to data when circumstances change. Specifically, if a league is added or removed from what I'll call system-specific "watch" lists then you just change the list of leagues for each system in the imagined worksheet, rather than messing with code every time that a list of leagues changes. And, having such lists in a separate worksheet would allow one macro to iterate through all the system lists rather than having separate code for each system. Plus you need some way to call each system-specific macro, with buttons for example. Depending on how many systems there are that means several buttons rather than just one for the lists approach. AND the list approach could include leagues that are yellow or red. I'd suggest having a separate worksheet with lists for green, yellow and red.

I hope that makes sense. And I am not trying to change your system, I am trying to help you make it better both for data management and for code construction. Nonetheless it seems that you are determined to do this a certain way.

If you change your mind let me know and I'll write code needed to process those "lists". Otherwise, this code works on the limited amount of data provided.

VBA Code: 
Sub LDT1()

'   Worksheet object for the worksheet where matches data is located.
    Dim wsData As Worksheet

'   First cell containing data.
    Dim rAnchorCell As Range
     
'   Count of rows in the matches data.
    Dim iDataRowsCount As Long
    
'   Used to iterate through entries in matches worksheet
    Dim iDataRow As Long
    
'   Array holding the leagues to process (look for for the system)
    Dim asLeagues() As String
    
'   This value = the number of "watch" leagues.
    Dim iLeaguesCount As Long
    
'   Used to iterate through leagues
    Dim iLeague As Long

    Set wsData = ThisWorkbook.Worksheets("MatchesList") '<= this is the worksheet with data

    Set rAnchorCell = wsData.Range("A1") '<= this is where data starts
    
'   Get count of rows in the matches data.
    iDataRowsCount = rAnchorCell.Offset(100000).End(xlUp).Row - rAnchorCell.Row + 1
    
'   Set count of leagues to look for.
    iLeaguesCount = 13   '<= change each time the count of leagues changes.
    
'   Set up array to hold iLeaguesCount  leagues
    ReDim asLeagues(iLeaguesCount)
    
'   Fill the array with leagues for the system
    asLeagues(1) = "Austria: 2. Liga"
    asLeagues(2) = "Australia: A -League"
    asLeagues(3) = "Bulgaria: Parva Liga"
    asLeagues(4) = "Czech Republic: Czech Liga"
    asLeagues(5) = "Denmark: Superliga"
    asLeagues(6) = "Germany: Bundesliga II"
    asLeagues(7) = "Greece: Superleague"
    asLeagues(8) = "Hungary: NB I"
    asLeagues(9) = "Portugal: Primeira Liga"
    asLeagues(10) = "Portugal: Segunda Liga"
    asLeagues(11) = "Poland: Ekstraklasa"
    asLeagues(12) = "Qatar: Q League"
    asLeagues(13) = "Turkey: Super Lig"

'   Iterate through all matches.
    For iDataRow = 1 To iDataRowsCount
    
'       Process leagues if the system name is found in column A.
        If rAnchorCell.Cells(iDataRow) Like "*LTD1*" _
         Then
    
'           Iterate through all "watch" leagues for the system.
            For iLeague = 1 To iLeaguesCount
            
'               Is the league in the list of leagues in column c?
                If rAnchorCell.Cells(iDataRow, 3) Like "*" & asLeagues(iLeague) & "*" _
                 Then
                 
'                   If system/league match is found color the cell in column E green.
                    With rAnchorCell.Cells(iDataRow, 5).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        
'                       This how Excel VBA refers to color RGB 146, 208, 79
                        .Color = 5230738
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                
                End If
                
            Next iLeague
        
        End If
    
    Next iDataRow

End Sub
 
Upvote 0

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
BTW, code above does nothing about removing green from cells that should not be green. Another advantage of code that processes all sytems at once is that it could start by clearing green from all cells before processing "new" ones.
 
Upvote 0
OaklandJim said:
I understand that data used for the decision are in columns A & C.

I don't mean to argue on the list but do you really want to go into code to change the list of leagues each time that leagues for a system change? The approach I imagine -- with lists -- would make coding that you want easy and would make it easier to make changes to data when circumstances change. Specifically, if a league is added or removed from what I'll call system-specific "watch" lists then you just change the list of leagues for each system in the imagined worksheet, rather than messing with code every time that a list of leagues changes. And, having such lists in a separate worksheet would allow one macro to iterate through all the system lists rather than having separate code for each system. Plus you need some way to call each system-specific macro, with buttons for example. Depending on how many systems there are that means several buttons rather than just one for the lists approach. AND the list approach could include leagues that are yellow or red. I'd suggest having a separate worksheet with lists for green, yellow and red.

I hope that makes sense. And I am not trying to change your system, I am trying to help you make it better both for data management and for code construction. Nonetheless it seems that you are determined to do this a certain way.

If you change your mind let me know and I'll write code needed to process those "lists". Otherwise, this code works on the limited amount of data provided.

VBA Code: 
Sub LDT1()

'   Worksheet object for the worksheet where matches data is located.
    Dim wsData As Worksheet

'   First cell containing data.
    Dim rAnchorCell As Range
   
'   Count of rows in the matches data.
    Dim iDataRowsCount As Long
  
'   Used to iterate through entries in matches worksheet
    Dim iDataRow As Long
  
'   Array holding the leagues to process (look for for the system)
    Dim asLeagues() As String
  
'   This value = the number of "watch" leagues.
    Dim iLeaguesCount As Long
  
'   Used to iterate through leagues
    Dim iLeague As Long

    Set wsData = ThisWorkbook.Worksheets("MatchesList") '<= this is the worksheet with data

    Set rAnchorCell = wsData.Range("A1") '<= this is where data starts
  
'   Get count of rows in the matches data.
    iDataRowsCount = rAnchorCell.Offset(100000).End(xlUp).Row - rAnchorCell.Row + 1
  
'   Set count of leagues to look for.
    iLeaguesCount = 13   '<= change each time the count of leagues changes.
  
'   Set up array to hold iLeaguesCount  leagues
    ReDim asLeagues(iLeaguesCount)
  
'   Fill the array with leagues for the system
    asLeagues(1) = "Austria: 2. Liga"
    asLeagues(2) = "Australia: A -League"
    asLeagues(3) = "Bulgaria: Parva Liga"
    asLeagues(4) = "Czech Republic: Czech Liga"
    asLeagues(5) = "Denmark: Superliga"
    asLeagues(6) = "Germany: Bundesliga II"
    asLeagues(7) = "Greece: Superleague"
    asLeagues(8) = "Hungary: NB I"
    asLeagues(9) = "Portugal: Primeira Liga"
    asLeagues(10) = "Portugal: Segunda Liga"
    asLeagues(11) = "Poland: Ekstraklasa"
    asLeagues(12) = "Qatar: Q League"
    asLeagues(13) = "Turkey: Super Lig"

'   Iterate through all matches.
    For iDataRow = 1 To iDataRowsCount
  
'       Process leagues if the system name is found in column A.
        If rAnchorCell.Cells(iDataRow) Like "*LTD1*" _
         Then
  
'           Iterate through all "watch" leagues for the system.
            For iLeague = 1 To iLeaguesCount
          
'               Is the league in the list of leagues in column c?
                If rAnchorCell.Cells(iDataRow, 3) Like "*" & asLeagues(iLeague) & "*" _
                 Then
               
'                   If system/league match is found color the cell in column E green.
                    With rAnchorCell.Cells(iDataRow, 5).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                      
'                       This how Excel VBA refers to color RGB 146, 208, 79
                        .Color = 5230738
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
              
                End If
              
            Next iLeague
      
        End If
  
    Next iDataRow

End Sub
Click to expand...
Cheers OaklandJim and apologies for the delay. Have been trying to get some new pages together for the website.

Thanks so much for all your work on this. One thing which it seems to stick on is the worksheet name.

VBA Code: 
Set wsData = thisWorkbook.Worksheets("Lay The Draw") '<= this is the worksheet with data

You initially had MatchesList there and I simply changed it to the name of the relevant sheet, but it falls over on that line with an RTE 9 - subscript out of range error. Any thoughts on that?

cheers
 
Upvote 0
Hi again OaklandJim
If it helps, here is the entire code, changed to reflect the leagues required

VBA Code: 
Sub LDT1_HOME_GREEN()

'   Worksheet object for the worksheet where matches data is located.
    Dim wsData As Worksheet

'   First cell containing data.
    Dim rAnchorCell As Range
     
'   Count of rows in the matches data.
    Dim iDataRowsCount As Long
    
'   Used to iterate through entries in matches worksheet
    Dim iDataRow As Long
    
'   Array holding the leagues to process (look for for the system)
    Dim asLeagues() As String
    
'   This value = the number of "watch" leagues.
    Dim iLeaguesCount As Long
    
'   Used to iterate through leagues
    Dim iLeague As Long

    Set wsData = thisWorkbook.Worksheets("Lay The Draw") '<= this is the worksheet with data

    Set rAnchorCell = wsData.Range("A1") '<= this is where data starts
    
'   Get count of rows in the matches data.
    iDataRowsCount = rAnchorCell.Offset(100000).End(xlUp).Row - rAnchorCell.Row + 1
    
'   Set count of leagues to look for.
    iLeaguesCount = 25   '<= change each time the count of leagues changes.
    
'   Set up array to hold iLeaguesCount  leagues
    ReDim asLeagues(iLeaguesCount)
    
'   Fill the array with leagues for the system
    asLeagues(1) = "Austria: 2. Liga"
    asLeagues(2) = "Australia: A-League"
    asLeagues(3) = "Bulgaria: Parva Liga"
    asLeagues(4) = "Czech Republic: Czech Liga"
    asLeagues(5) = "Denmark: Superliga"
    asLeagues(6) = "Germany: Bundesliga II"
    asLeagues(7) = "Greece: Superleague"
    asLeagues(8) = "Hungary: NB I"
    asLeagues(9) = "Portugal: Primeira Liga"
    asLeagues(10) = "Portugal: Segunda Liga"
    asLeagues(11) = "Poland: Ekstraklasa"
    asLeagues(12) = "Qatar: Q League"
    asLeagues(13) = "Turkey: Super Lig"
    asLeagues(14) = "Chile: Primera Division"
    asLeagues(15) = "Colombia: Primera A"
    asLeagues(16) = "Ecuador: Primera B"
    asLeagues(17) = "Iceland: Inkasso-Deildin"
    asLeagues(18) = "Ireland: Premier Division"
    asLeagues(19) = "Korea: K-League Classic"
    asLeagues(20) = "Lithuania: A Lyga"
    asLeagues(21) = "Norway: Elieserien"
    asLeagues(22) = "Peru: Segunda Division"
    asLeagues(23) = "Sweden: Superettan"
    asLeagues(24) = "Sweden: Division 1 - Sodra"
    asLeagues(25) = "USA: MLS"
    

'   Iterate through all matches.
    For iDataRow = 1 To iDataRowsCount
    
'       Process leagues if the system name is found in column A.
        If rAnchorCell.Cells(iDataRow) Like "*LTD1_HOME*" _
         Then
    
'           Iterate through all "watch" leagues for the system.
            For iLeague = 1 To iLeaguesCount
            
'               Is the league in the list of leagues in column c?
                If rAnchorCell.Cells(iDataRow, 3) Like "*" & asLeagues(iLeague) & "*" _
                 Then
                 
'                   If system/league match is found color the cell in column E green.
                    With rAnchorCell.Cells(iDataRow, 5).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        
'                       This how Excel VBA refers to color RGB 146, 208, 79
                        .Color = 5230738
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                
                End If
                
            Next iLeague
        
        End If
    
    Next iDataRow

End Sub

As indicated, the macro falls over on the line

VBA Code: 
Set wsData = thisWorkbook.Worksheets("Lay The Draw") '<= this is the worksheet with data

It generates an RTE 9 - subscript out of range error. I do need to have the sheet names in each of the macros as I will need to be able to call all the ones I create, so can't have it simply the worksheet which is currently selected, if that makes sense.

cheers
 
Upvote 0
Howdy @OaklandJim

Sorry to ask after all your hard work, but any thoughts on why the code stalls on the line mentioned above?

Thanks so much in advance
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
football Recent Form
Replies
9
Views
1K
bonezvillefc
B
CubaRJ
  • Solved
VBA to Color Each Cell in a Range to show OnDuty and other color to show OffDuty
Replies
8
Views
501
CubaRJ
CubaRJ

Forum statistics

Threads
1,214,968
Messages
6,122,509
Members
449,089
Latest member
RandomExceller01

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top