Save Excel ColorIndex Value in column field.

dtlst · #1 (**permalink**) 02-22-05, 18:27

I received several financial worksheets from another agency that need to be imported into Access. I created some macros that clean up the extra rows, unnecessary data, etc. but have one last problem. The originator of the worksheets used colors to identify specific information relative to each row or blocks of rows.
In a series of 20 rows there might be 4 different colors used to identify lines meeting different critiera. A blue line could mean the project costs were included in the first quarter snapshot, a green line could mean that the "amount" is a projected estimate, etc. In one of the macros I've created I added a new column. I need to place the ColorIndex value into the column/row for each row based on the color they are. I seem to be able to change the background color based on a field value easily enough but am grappling with the reverse. Any suggestions would be appreciated. If this note is a duplicate......it's because I wasn't sure if the first one completed properly. Thanks

DavidCoutts · #2 (**permalink**) 02-23-05, 04:21

is something like this what your after

Code:

Sub ColorNumbers()
Dim cell As Range
    For Each cell In Range(Cells(1, 1), Cells(20, 1))
        cell.Offset(0, 1).Value = cell.Interior.ColorIndex
    Next cell
End Sub

HTH
Dave

dtlst · #3 (**permalink**) 02-23-05, 17:37

Thanks for your help. I was able to use it on the worksheets that didn't use conditional formatting to apply the row colors.

Thanks again!

DavidCoutts · #4 (**permalink**) 02-24-05, 06:16

Ok just as an extension ive produced some code that will work with conditional formatting as well

Code:

Sub GetColourIndex(rngTest As Range)
    'obtains the displayed colorindex for a range of cells
    'works with normal formating and conditional formating
    'written by D Coutts on 24/02/2005
    Dim cl  As Range
    Dim cl2 As Range
    
    'loop through each cell and check formatting Conditional or otherwise
    For Each cl In rngTest
        Set cl2 = cl.Offset(0, 1)
        'count the number of conditional formats on the specific cell
        For i = 1 To cl.FormatConditions.Count
            With cl.FormatConditions.Item(i)
                'check to see if type cell value is or formula is
                If .Type = 1 Then
                    'if cell value is then obtain the type and see if cell matches conditions
                    'if it does display the colorindex of that cell in next cell
                    Select Case .Operator
                        Case xlLess
                            If CStr(cl.Value) < .Formula1 Then _
                                cl2.Formula = .Interior.ColorIndex
                        Case xlBetween
                            If cl.Value >= CInt(.Formula1) And cl.Value <= CInt(.Formula2) Then _
                                cl2.Formula = .Interior.ColorIndex
                        Case xlGreater
                            If CStr(cl.Value) > .Formula1 Then _
                                cl2.Formula = .Interior.ColorIndex
                        Case xlNotBetween
                            If Not (CStr(cl.Value) >= .Formula1 And CStr(cl.Value) <= .Formula2) Then _
                                cl2.Formula = .Interior.ColorIndex
                        Case xlGreaterEqual
                            If CStr(cl.Value) >= .Formula1 Then _
                                cl2.Formula = .Interior.ColorIndex
                        Case xlLessEqual
                            If CStr(cl.Value) <= .Formula1 Then _
                                cl2.Formula = .Interior.ColorIndex
                        Case xlEqual
                            If CStr(cl.Value) = .Formula1 Then _
                                cl2.Formula = .Interior.ColorIndex
                        Case xlNotEqual
                            If Not (CStr(cl.Value) = .Formula1) Then _
                                cl2.Formula = .Interior.ColorIndex
                    End Select
                'if type of conditional format is formulais then calculate the formula
                'and match with the cell value
                ElseIf .Type = 2 Then
                    cl2.Formula = .Formula1
                    If cl.Value = cl2.Value Then
                        cl2.Formula = .Interior.ColorIndex
                    Else
                        'if no match set the written cell value to be blank
                        cl2.Formula = ""
                    End If
                End If
                
            End With
        Next i
        'for every cell without a conditional format applied pick up the colorindex
        If cl2.Formula = "" Then
            cl2.Value = cl.Interior.ColorIndex
        End If
    Next cl
    
    'clear object variables
    Set cl = Nothing
    Set cl2 = Nothing
End Sub

to use the above code write a small procedure such as this

Code:

Sub useabove()
    Range("b1").EntireColumn.Insert
    GetColourIndex Range("A1:A15")
End Sub

Hope this will make things a bit easier for you
All the best
Dave

Internet Services

Web Development

Digital Marketing

Consumer Tech