Results 1 to 11 of 11
  1. #1
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,815
    Thanks
    132
    Thanked 479 Times in 456 Posts

    fast vba method to set background colour for record rows by Country

    Hi

    Using Excel2013 (or Excel2010):

    I have an entirely blank row9.
    I have a headings row, in row10, range [a10:z10]
    I have a block of data, in cells [a11:z3000]

    The heading in [K10] is "Country".
    In the data records, I only have 10 Countries.
    I want to have all the record rows coloured according to the Country.
    e.g. for England, I want the cell interior colour to be a specified value,
    for all England records, from column range [A] to [Z]

    I have a separate named range on another sheet, which has the Country,
    and in the adjacent cell, the required interior colour for that Country.

    I'm looking for a fast vba way to set the colour for all the records.
    I think the fastest way is to use the autofilter property, set it to filter
    on each of the country values, then select these 'visible' filtered records,
    and apply the required interior cell colour for all the visible cells as required.

    Is this the best, fastest way (i.e. rather than looping through each record one-at-a-time)???

    zeddy

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    Zeddy,

    If you are ONLY going to ever have 10 countries why not a conditional formatting chain like.
    Zeddy.JPG
    zeddy2.JPG
    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. #3
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    Zeddy,

    Here's another option which may prove more flexible:

    If you define a dynamic range name for say 30000 rows as such:
    Name: Databas
    Refers to: =OFFSET(Sheet1!$A$11,0,0,COUNTA(Sheet1!$K$11:$K$30 011),26
    You can use the following code to set the conditional formats:
    Code:
    Option Explicit
    
    Sub CondFmt()
    
        Cells.FormatConditions.Delete   '*** Delete All Sheet Conditional Fmts ***
        
        Range("Database").FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$K11=""USA"""
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1)
            With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
            End With
        End With
        
        Range("Database").FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$K11=""United Kingdom"""
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1)
            With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 15773696
            .TintAndShade = 0
            End With
        End With
        
        Range("Database").FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$K11=""Germany"""
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1)
            With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 5287936
            .TintAndShade = 0
            End With
        End With
        
        Range("Database").FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$K11=""France"""
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1)
            With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            End With
        End With
    
    '*** Note: The following conditional for blank countries MUST be last!  ***
    '***       Or it may not be necessary at all but it is a safety measure ***
        Range("Database").FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$K11="""""
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1)
            With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 16777215
            .TintAndShade = 0
            End With
        End With
    
    End Sub 'CondFmt()
    Please Note: The macro MUST be rerun any time the number of rows INCREASES. This is because Conditional Formatting will not allow the storage of a dynamic range name. You can use it to establish the initial parameters but it will resolve it to an actual address range and will not recalculate it. That is why the use of the macro to delete existing conditional formats and reestablish them reinterpreting the dynamic range name.

    Of course you'll have to add code for more countries but that is just cut and paste changing the country name and color.
    You can easily get the color codes by coloring a cell the desired color, selecting it then use:
    ?Activecell.Interior.Color
    in the VBE Immediate window.

    HTH

    P.S. Instead of using a dynamic range name you could include code to just recreate the range references at the top of routine if you would rather approach it that way.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  4. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    Zeddy,

    Best Version Yet! (Hope you don't mind a little self promotion )

    This version is closer to your original spec as it uses your color table, see graphic, which is easily expanded for as many countries as your want. The code will automatically adjust to the table (no coding required).
    ColorTable.JPG
    Code:
    Option Explicit
    
    '*** BY: RetiredGeek ***
    '*** 2014-10-06      ***
    
    Function CFItem(zCntry As String, lColor As Long)
    
        Dim zFormula As String
    
        zFormula = "=$K11=" & Chr(34) & zCntry & Chr(34)
        With Range("Database")
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
            zFormula
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
            With .FormatConditions(1)
                With .Interior
                    .PatternColorIndex = xlAutomatic
                    .Color = lColor
                    .TintAndShade = 0
                End With
            End With
        End With
    
    End Function
    
    Sub CondFmt()
    
       Dim iCntr As Integer
       Dim rngCT As Range
    
        Cells.FormatConditions.Delete   '*** Delete All Sheet Conditional Fmts ***
        
        Set rngCT = Range("ColorTable")
        For iCntr = 1 To rngCT.Rows.Count
           CFItem rngCT.Cells(iCntr, 1), rngCT.Cells(iCntr, 2)
        Next iCntr
    
        'Allow for blanked out country names after formatting
        CFItem "", 16777215
        
    End Sub 'CondFmt()
    You may want to include a line of code to make sure it only operates on the desired sheet!

    HTH

    P.S. I didn't delete the earlier versions to show how code can be cleaned up after the initial concept has been tested and how code can always be improved...as I'm sure someone else will probably do to this!
    Last edited by RetiredGeek; 2014-10-06 at 19:28.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  5. The Following User Says Thank You to RetiredGeek For This Useful Post:

    zeddy (2014-10-09)

  6. #5
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,629
    Thanks
    114
    Thanked 644 Times in 588 Posts
    Zeddy,

    Here is an alternate Code using a Vlookup (Although a loop, it is fast):

    Code:
    Public Sub FindCountry()
    On Error Resume Next
    Application.ScreenUpdating = False
    '--------------------------------
    'DECLARE AND SET VALUES
        Dim rng As Range
        Dim cell As Range
        Dim Cindex As Integer
        Dim Row As Integer
        LastRow = ActiveSheet.Cells(Rows.Count, 11).End(xlUp).Row
        Set rng = Range("K11:K" & LastRow)
    '--------------------------------
    'VLOOKUP COUNTRY THEN COLOR ROW
        With Worksheets("Sheet2")
        For Each cell In rng
            Cindex = WorksheetFunction.VLookup(cell, .Range("A1:B10"), 2, False)
            Row = cell.Row
            Range(Cells(Row, 1), Cells(Row, 26)).Interior.ColorIndex = Cindex
        Next cell
        End With
        Application.ScreenUpdating = True
    End Sub
    Country1.png

    Country2.png

    HTH,
    Maud
    Attached Files Attached Files
    Last edited by Maudibe; 2014-10-06 at 22:24.

  7. The Following User Says Thank You to Maudibe For This Useful Post:

    zeddy (2014-10-09)

  8. #6
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,815
    Thanks
    132
    Thanked 479 Times in 456 Posts
    Hi RG and Maud

    Many thanks for your help on this, apologies for delay in responding.
    Both of your methods were excellent, and I am very grateful for your quick response to my request.

    As it turned out, I didn't want to use conditional format method (as there were other conditional formats already on the sheet, above the header row).
    Maud's method was indeed fast (many thanks for including the test sample file).
    However, I wanted a simpler way for the colours to be defined.
    The most intuitive way I thought, would be to set the background colour as wanted, in each of the Country values in the table.
    I defined a custom function to fetch the interior cell colour, and placed the custom function formula in the adjacent cell.
    However, changing the cell background colour does not trigger any calculation event, so this caused problems.
    I did get the solution sorted.
    I'll post back more if anyone is interested.

    zeddy

  9. #7
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,815
    Thanks
    132
    Thanked 479 Times in 456 Posts
    Hi All

    I have attached a sample file (based on Maud's file - many thanks for that again!) to show you the method I used.

    zeddy
    Attached Files Attached Files

  10. #8
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,629
    Thanks
    114
    Thanked 644 Times in 588 Posts
    Zeddy,

    Clever to use filtering....nice! Using your code, here is real fast and easy way to define your colors. Click a color then click the country. The country then changes to that color. The Current Color box displays the currently selected color.

    CountryColors.png

    Code:
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    '---------------------------------
    'CHECK IF MORE THAN ONE CELL SELECTED
        If Target.Cells.Count > 1 Then Exit Sub
    '---------------------------------
    'GET COLOR FROM COLOR SAMPLES
        If Not Intersect(Target, Range("E4:E13")) Is Nothing Then
            Range("B17").Interior.Color = Target.Interior.Color
        End If
    '---------------------------------
    'APPLY COLOR TO SELECTED COUNTRY
        If Not Intersect(Target, Range("B4:B13")) Is Nothing Then
            Target.Interior.Color = Range("B17").Interior.Color
            colour = 0
        End If
    End Sub
    Attached Files Attached Files

  11. The Following User Says Thank You to Maudibe For This Useful Post:

    zeddy (2014-10-10)

  12. #9
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,815
    Thanks
    132
    Thanked 479 Times in 456 Posts
    Hi Maud

    ..but there are thousands and thousands and thousands of colours to choose from.
    Not counting Theme colours etc.
    So rather than let the User be restricted to any 'pre-defined' colours on the sheet, I let them choose the background cell colour directly via the top panel Ribbon, [Home] tab, [Font] section, where you see the 'tipping-paint-pot'.
    Clicking this paint-pot, then clicking [Custom] opens up a wide range of colour options.

    But many thanks for your idea, which would certainly be useful in particular cases.

    zeddy

  13. #10
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,629
    Thanks
    114
    Thanked 644 Times in 588 Posts
    Zeddy,

    Then perhaps this is the fastest way yet to provide a method to let the user select the thousands of available colors. Clicking on a country will open the Edit Color Dialogue box. The user selects the color and the interior color of the country changes to that color. Your code then runs when activating your data sheet and the new color is applied. You will save several mouse clicks by not having to select the correct menu on the ribbon, click on the fill color, then click on more colors.

    ColorDialogue.png

    Code:
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    '---------------------------------
    'CHECK IF MORE THAN ONE CELL SELECTED
        If Target.Cells.Count > 1 Then Exit Sub
    '---------------------------------
    'CHECK IF A COUNTRY IS SELECTED
        If Not Intersect(Target, Range("B4:B13")) Is Nothing Then
    '---------------------------------
    'CONVERT TO RGB
            ActiveColor = Target.Interior.Color
            Red = ActiveColor Mod 256
            Green = (ActiveColor / 256) Mod 256
            Blue = (ActiveColor / 24336) Mod 256
    '---------------------------------
    'ASSIGN COLOR 1 IN THE CURRENT PALLETE TO THE NEW RGB COLOR
            If Application.Dialogs(xlDialogEditColor).Show(1, Red, Green, Blue) = True Then
                Target.Interior.Color = ActiveWorkbook.Colors(1)
            End If
    '---------------------------------
    'RESET COLOR 1 BACK TO ORIGINAL COLOR
            ActiveWorkbook.Colors(1) = 1    
    End If
    End Sub
    Attached Files Attached Files

  14. The Following User Says Thank You to Maudibe For This Useful Post:

    zeddy (2014-10-12)

  15. #11
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,815
    Thanks
    132
    Thanked 479 Times in 456 Posts
    Hi Maud

    Many thanks.
    Saving mouse clicks is good.
    Excellent!

    zeddy

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •