VBA for color

[BevM]

This is my second week learning VBA, so I'm having a little bit of trouble. I have a spreadsheet that has a mix of hard coded numbers and formulas. I need to color the last hard coded row in the sheet with a dark pink, the 15 rows after that with a lighter pink, and the row after these 15 with the same dark pink. I already set up a formula (=isformula(H593))to tell me if it's hard coded (FALSE) or Formula (TRUE) and then, in the column next to that, I have an IF function for where the darker pink rows should be (=IF(BD593=BD594,"","dark")).

Here is my code for one of the dark rows (which does not work):

Sub Color()
    'Putting Dark color on bottom row
    If Columns("BE").Find(what:="dark", _
    after:=Range("BE610").End(xlUp), _
    SearchDirection:=xlPrevious).Activate Then
    'Color entire row
    ActiveCell.EntireRow.Select
    Selection.Interior.TintAndShade = 0.599993896298105
  Else
      'Do nothing
  End If
End Sub

Any suggestions? After I figure this first row out, I will move on to the rest, unless you think it should all be in one sub. Also, would there be a way to color part of the row (for instance, columns F:P)?

 

[ElBombay]

Welcome to the board, BevM

The code below is something I put together to expalin a spreadsheet for someone (please bear that in mind when reading the comments) but the "cCell()" macro should give you the numbers for a particualr color that you have already palced on the sheet. My client-base has Excel ranging from "'97-'03" thruogh 2010 so I am using .Color for "backward compatability" but you can change lines from "Selection.Font.Color" to "Selection.Font.ColorIndex" or even "Selection.Font.ThemeColor" to return the number needed. And my code is very generalized for similar reasons.

Put a break (F9) in the code and hover the cursor over the variable to see the nimber returned by Excel. Remember to define the variables as 'Long' since 'Integer' only goes to 32K.

I know what I'm trying to say but better coders than me have asked for clarification on some of my posts. Remember, a computer's binary brain can only count to 1 so never let code intimidate you!

Private Sub Macro6()
'
'Example of recorded macro with "Private" added to keep it from appearing
'   on the menu when the user hits F8.


'
    With Selection.Font
        .Name = "Cambria"
        .FontStyle = "Bold"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("E3").Select
End Sub
'--------------------------------------------------------------------------------
Sub cCell()
'
'Macro to return color-codes for use in customizing appearance
'Font & Interior must be set from r-click menu before running this macro
'25MAR12
'
    Range("E2").Select
    iBlack = Selection.Font.Color
    iWhite = Selection.Interior.Color
    With Selection
        .Font.Color = 2                 'Black
        .Interior.Color = 16777215      'White
    End With
    
    Range("E3").Select
    iWhite = Selection.Font.Color
    iRed = Selection.Interior.Color
    With Selection
        .Font.Color = 16777215          'White
        .Interior.Color = 255           'Red
    End With
    
    Range("E4").Select
    iBlack = Selection.Font.Color
    iYellow = Selection.Interior.Color
    With Selection
        .Font.Color = 2                 'Black
        .Interior.Color = 65535         'Yellow (also = 64K)
    End With
    
    Range("E5").Select
    iBlack = Selection.Font.Color
    iGreen = Selection.Interior.Color
    With Selection
        .Font.Color = 2                 'Black
        .Interior.Color = 65280         'Green found in "F1"
    End With

    Range("f1").Select
    'Set to read the green used in column-header
    iBlack = Selection.Font.Color
    iGreen = Selection.Interior.Color
End Sub

 

[BevM]

ElBombay, thanks for your reply!

Do you know how to have it only color the specific types of rows that I want (the last hard coded row as dark pink, the 15 forumla rows below that as light pink, and then the final formula row as dark pink) rather than coloring a constant row? I can figure out the code for the colors easy enough by recording a macro but I can't figure out how to color it for an IF statement within VBA (which is what my code was attempting to do)

Welcome to the board, BevM

The code below is something I put together to expalin a spreadsheet for someone (please bear that in mind when reading the comments) but the "cCell()" macro should give you the numbers for a particualr color that you have already palced on the sheet. My client-base has Excel ranging from "'97-'03" thruogh 2010 so I am using .Color for "backward compatability" but you can change lines from "Selection.Font.Color" to "Selection.Font.ColorIndex" or even "Selection.Font.ThemeColor" to return the number needed. And my code is very generalized for similar reasons.

Put a break (F9) in the code and hover the cursor over the variable to see the nimber returned by Excel. Remember to define the variables as 'Long' since 'Integer' only goes to 32K.

I know what I'm trying to say but better coders than me have asked for clarification on some of my posts. Remember, a computer's binary brain can only count to 1 so never let code intimidate you!

Private Sub Macro6()
'
'Example of recorded macro with "Private" added to keep it from appearing
'   on the menu when the user hits F8.
 
 
'
    With Selection.Font
        .Name = "Cambria"
        .FontStyle = "Bold"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("E3").Select
End Sub
'--------------------------------------------------------------------------------
Sub cCell()
'
'Macro to return color-codes for use in customizing appearance
'Font & Interior must be set from r-click menu before running this macro
'25MAR12
'
    Range("E2").Select
    iBlack = Selection.Font.Color
    iWhite = Selection.Interior.Color
    With Selection
        .Font.Color = 2                 'Black
        .Interior.Color = 16777215      'White
    End With
 
    Range("E3").Select
    iWhite = Selection.Font.Color
    iRed = Selection.Interior.Color
    With Selection
        .Font.Color = 16777215          'White
        .Interior.Color = 255           'Red
    End With
 
    Range("E4").Select
    iBlack = Selection.Font.Color
    iYellow = Selection.Interior.Color
    With Selection
        .Font.Color = 2                 'Black
        .Interior.Color = 65535         'Yellow (also = 64K)
    End With
 
    Range("E5").Select
    iBlack = Selection.Font.Color
    iGreen = Selection.Interior.Color
    With Selection
        .Font.Color = 2                 'Black
        .Interior.Color = 65280         'Green found in "F1"
    End With
 
    Range("f1").Select
    'Set to read the green used in column-header
    iBlack = Selection.Font.Color
    iGreen = Selection.Interior.Color
End Sub

 

[ElBombay]

BevM,

I think this is what you are asking for. Obviously, you'll have to modify certain test-vaues but the structure should work for you. And since you're just using 2 colors, you can probaly jsut code the "color routines" into your IF test rather than calling the Subs that I do. Good luck.

I threw the cColor macro out there because the recorder sometimes returns the .Color value, sometimes .ColorIndex, sometimes xlAutomatic, etc., so I need to fiind a common value for re-useability. You're working with a single system so I seem to have over-explained/over-thought the question. I'm happy to clarify further (or address the right topic?) if you'd like.

'-----------------------------------------------------------------------------------
        'Find "the last hard coded row"
        Color_FullRow()
        Do Until ActiveCell.Offset(1, 0).Value = "WKTOT"      'Some flag for hard-code vs Formula
            zSkip                                                            'Utility to ".Offset(1,0)"
            If ActiveCell.Value <> "" Then  'it's a Type-code (now formula)
                If ActiveCell.Offset(0, 3).Value = 0 Then
                'No pmts or credits for this TYPE were received
                    'zDel_Row 1                                              'My existing code
                    'zMove_Up 1
                    'Color 3 columns in current row
                    zColor_Row "DPINK", 3                                 'Your changes
                    'OR make the entire row Dark Pink
                    Color_FullRow()
                    
                Else                        'Highlight the Subtot value (now alternative is "hard code")
                    zMove_Right (1)
                    zColor_Row "PINK", 3
                    zMove_Left 3
                    xChk_Font
                    zMove_Left 1
            
               End If
            End If
        Loop
'-----------------------------------------------------------------------------------
Sub zColor_Row(cColor as String, iCol as Integer)
'
'Dependant module.  Cursor must be in 1st cell of column-range to
'   be filled in when this module is called.
'The mVar iCol is the number of columns, NOT the Excel column-number
'Will grow w/ color codes as needed
'Use .Color and '97-'03 codes for portability
'Test to ensure these older codes still funtion as intended
'9/8/10; Filled-in 30JAN11
    'Use standard Black font for these colors
    '.ColorIndex = 27 = "YELLOW"
    '.ColorIndex = 4 = "GREEN"
    '.ColorIndex = 28 = "TEAL"
    '.ColorIndex = 2 = "PINK"
    '.ColorIndex = 46 = "DPINK
    'Use White font for these colors
    '.ColorIndex = 3 = "RED"
    '.ColorIndex = 32 = "ROYAL BLUE"
    '.ColorIndex = 31 = "AQUA"
'
Dim i As Integer, iError As Integer, iFont As Integer
Dim iColor As Long
On Error GoTo Err_ColorCol:

    cColor = UCase(cColor)
    iFont = 1                       'Standard black font
    Select Case cColor
    Case "GREEN"
        iColor = 4
    
    Case "YELLOW"
        iColor = 27
    
    Case "TEAL"
        iColor = 28
    
    Case "PINK"
        iColor = 12106214
        
    Case "DPINK"
        iColor = 255
            
    Case Else                       'Colors calling for a white font
        iFont = 2                   'White font for clarity
        Case "RED"
            iColor = 3
        
        Case "AQUA"
            iColor = 31

        Case "ROYAL BLUE"
            iColor = 32
            
        End Select
    End Select

    For i = 1 To iCol
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = iColor
            .Font = iFont
            'These 2 don't work in XL2003
            '.TintAndShade = 0
            '.PatternTintAndShade = 0
        End With
        zMove_Right (1)
    Next
    'Fix borders that were erased during routine
    'Selection.Interior.Color = iSaveColor       '???

Err_ColorRow:
    'Store E.Num to mVar for readability
    iError = Err.Number
    Select Case iError
    Case 0
        'Clean up and exit normally

    Case 91
        MsgBox (cColor & " not yet an option.  Choose another color for " _
                    & "now and call Jim to modify the program.")
    
    Case Else
        zUnexpected_Err (iError)
        End
        
    End Select
    On Error GoTo 0

End Sub
'-----------------------------------------------------------------------------------
Sub Color_FullRow()
'
'
'
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255                                'Dark Pink in '97-03
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

 

[ElBombay]

BevM,

My most sincere apologies. I was re-reading your post and just noticed that you began by saying you've only been working with VBA for two weeks. I had some code experience before the Board very generously began helping me 5 years ago and I know I would have not been able to digest all the code I've been throwing at you. You may well have understood and learned from what I posted but it was still totally inappropriate to overwhelm you with the code I did.

I don't usually try to write code for someone else's app; there are just too many gaps in sheet-specific knowldge for one thing. I am offering the code below as a starting point for what I think you are after. Again, I'm sorry for the avoidable oversight and I hope this gets you on your way to a timely solution.

Sub Color()
Dim iRow As Long
'
    'Putting Dark color on bottom row
    If Columns("BE").Find(what:="dark", after:=Range("BE610").End(xlUp), _
                                            SearchDirection:=xlPrevious).Activate Then
        'Color entire row
        'ActiveCell.EntireRow.Select
        iRow = ActiveCell.Row
        Cells(iRow, 6).Activate                     'Move to column F in current Row
        Selection.Interior.TintAndShade = 0.599993896298105
    End If
    'Color Columns F thru P
    Do
        iRow = ActiveCell.Row
        Cells(iRow, 6).Activate                     'Move to column F in current Row
        For i = 1 To 11
            '[Change to code for Light Pink]
            Selection.Interior.TintAndShade = 0.5 'xxxxxxx
            ActiveCell.Offset(0, 1).Activate        'Move Right 1 Column
        Next
        ActiveCell.Offset(1, 0).Activate            'Move Down 1 Row

    Loop Until (isformula(593, ActiveCell.Column))
    iRow = ActiveCell.Row
    Cells(iRow, 6).Activate                         'Move to column F in current Row
    Selection.Interior.TintAndShade = 0.599993896298105
    
End Sub
'-----------------------------------------------------------------------------------

 

[BevM]

Thanks ElBombay! I'll try this code (with some edits, obviously) and let you know if I run into any problems. And, yes, I tried reading through your code above and was a little confused but, I've been attempting to write different codes now for a few weeks so I'm starting to understand the jargon and format

Thanks again for your help and, as always, your speedy responses!

BevM,

My most sincere apologies. I was re-reading your post and just noticed that you began by saying you've only been working with VBA for two weeks. I had some code experience before the Board very generously began helping me 5 years ago and I know I would have not been able to digest all the code I've been throwing at you. You may well have understood and learned from what I posted but it was still totally inappropriate to overwhelm you with the code I did.

I don't usually try to write code for someone else's app; there are just too many gaps in sheet-specific knowldge for one thing. I am offering the code below as a starting point for what I think you are after. Again, I'm sorry for the avoidable oversight and I hope this gets you on your way to a timely solution.

Sub Color()
Dim iRow As Long
'
    'Putting Dark color on bottom row
    If Columns("BE").Find(what:="dark", after:=Range("BE610").End(xlUp), _
                                            SearchDirection:=xlPrevious).Activate Then
        'Color entire row
        'ActiveCell.EntireRow.Select
        iRow = ActiveCell.Row
        Cells(iRow, 6).Activate                     'Move to column F in current Row
        Selection.Interior.TintAndShade = 0.599993896298105
    End If
    'Color Columns F thru P
    Do
        iRow = ActiveCell.Row
        Cells(iRow, 6).Activate                     'Move to column F in current Row
        For i = 1 To 11
            '[Change to code for Light Pink]
            Selection.Interior.TintAndShade = 0.5 'xxxxxxx
            ActiveCell.Offset(0, 1).Activate        'Move Right 1 Column
        Next
        ActiveCell.Offset(1, 0).Activate            'Move Down 1 Row
 
    Loop Until (isformula(593, ActiveCell.Column))
    iRow = ActiveCell.Row
    Cells(iRow, 6).Activate                         'Move to column F in current Row
    Selection.Interior.TintAndShade = 0.599993896298105
 
End Sub
'-----------------------------------------------------------------------------------