Excel

Color several multi-column sections at one time based on criteria

Ease of Use

Intermediate

Version tested with

2000, 2002, 2003, 2004 (Mac) 

Submitted by:

shades

Description:

With several columns of data related to one, this will color each item in the same row, and can color several sets of columns at one time 

Discussion:

Suppose that your data is in three columns, and then you have another set of data, also in three columns, and so on. You desire to format cells in the sets of three columns based on each company with the consistent color associated with each company. 

Code:

instructions for use 

			
Option Explicit 
 
Sub ColorColumns() 
     'Allows the SOV Rank by Tier to be colored with the competitors' colors
    Dim i As Long, j As Long, k As Long 
    Dim m As Integer, n As Integer, p As Integer, LastCol As Integer 
    Dim Rngi As Range, Rng As Range, Celli As Range, myStart As Range 
    Dim LastRow As Long 
    On Error Resume Next 
    Set myStart = Application.InputBox("Choose Start cell to color", Type:=8) 
     '   Error Handling
    If myStart = "" Then GoTo Out 
     
     'm, p, n are values for determining size of project
    m = myStart.Column 
    p = myStart.Row 
    n = Application.InputBox("Columns to be colored?", Type:=1) 
     ' Error Handling
    If n = 0 Then GoTo Out 
    LastCol = myStart.End(xlToRight).Column 
     '    MsgBox LastCol
    LastRow = myStart.End(xlDown).Row 
     '    MsgBox LastRow
    Application.ScreenUpdating = False 
     'k is the base column for each rank (1-6), Step is n (columns
     ' to be colored
    On Error Resume Next 
    For k = m To LastCol Step n 
         'j determines the offset with each rank
        For j = 0 To n - 1 
             'i goes through each row, starting at row 4, and going
             'to the LastRow
            For i = p To LastRow 
                 'Celli becomes the base cell to check for values
                Set Celli = Cells(i, k) 
                Set Rngi = Celli.Offset(0, j) 
                With Rngi 
                    Select Case Celli.Value 
Case "AAA": 
                        .Interior.ColorIndex = 32 
                        .Font.Color = vbWhite 
                    Case "BBB" 
                        .Interior.ColorIndex = 44 
                        .Font.Color = vbBlack 
Case "CCC": 
                        .Interior.ColorIndex = 6 
                        .Font.Color = vbBlack 
Case "DDD": 
                        .Interior.ColorIndex = 6 
                        .Font.Color = vbBlack 
Case "FFF": 
                        .Interior.ColorIndex = 3 
                        .Font.Color = vbWhite 
Case "GGG": 
                        .Interior.ColorIndex = 38 
                        .Font.Color = vbBlack 
Case "HHH": 
                        .Interior.ColorIndex = 1 
                        .Font.Color = vbWhite 
                    Case Else 
                        .Interior.ColorIndex = 2 
                        .Font.Color = vbBlack 
                    End Select 
                End With 
            Next i 
        Next j 
    Next k 
     'Clean up
    Set Rng = Nothing 
    Set Rngi = Nothing 
    Set Celli = Nothing 
    Set myStart = Nothing 
    Exit Sub 
     'Error handling
Out: 
    MsgBox ("User clicked cancel or left blank") 
    Application.ScreenUpdating = True 
End Sub

How to use:

  1. (Test the example first, then close the example)
  2. In the VBE, on the left in Project Explorer, choose Personal.xls and open modules.
  3. On menu select Insert > Module (a new module window appears on the right).
  4. Paste the above code into that window.
  5. Close the VBE, and Quit Excel. When prompted to save the Personal Macro Workbook, click "Yes".
  6. Open Excel, right-click a toolbar, and choose "Customize".
  7. On the center tab ("Commands", on the left choose "Macros" on the right, click and drag to the toolbar, "Custom Menu Item". When you see the heavy vertical line, release the mouse button.
  8. Right-click the new button and choose "Assign macro" and scroll through the list to select "ColorColumn".
  9. Right-click the button again, and click on "Name" and type the name you want assigned. Click OK.
  10. Test the button on your own data.
  11. To change companies or colors, make the changes in the "Select Case" portion of the code.
 

Test the code:

  1. Open the sample workbook.
  2. Click the "Color" button on the worksheet.
  3. On the prompt it will ask you to select the cell to begin. In this case it is cell $B$2, so click on the cell.
  4. Then the prompt will ask how many columns (this is not total columns, but how many in each section). In this case it is 3.
  5. When finished, Columns B:D, E:G, H:J will each be colored according to the company listed in the first column of each section (columns B, E, H). No need to have data sorted
 

Sample File:

ColorVBA.zip 10.35KB 

Approved by mdmackillop


This entry has been viewed 131 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express