Excel Cell Shading + Percent

[bluenose76]

Hi,

I have a workbook with several worksheets. The first sheet is the summary page that purely shows percentages that are cells displaying the contest of the cells on all other pages.

What I would like to do is use a little VB to shade the cell dependant upon what percentage is displayed

100%. =. Green

<50%. =. Red

>50% but less than 100% =. Amber

I do not wish to use conditional formatting to do this.

I allready use VB elsewhere in my workbook to shade cells based on text that is in them.

Thank you all in advance and I look forward to your guidance.

Regards,
Arran

 

[Rx_]

Is the code to run from inside Excel?
Or, are you gathering data with Access and creating the Excel with automation from Access?

 

[bluenose76]

Is the code to run from inside Excel?
Or, are you gathering data with Access and creating the Excel with automation from Access?

Rx,

the code is to run inside excel

sheet one simply displays the contents of a cell within sheet two, three, four etc.

the data is manually populated into the other sheets, calculations are done on those sheets to work out the percentages.

the "Summary" Sheet simply shows those percentages, i wish to colour code them to simplify what is being viewed

regards
arran

 

[Rx_]

The OBJXL with a period after it is object code to run this from MS Access code against an Excel module. So since yours runs from inside Excel, remove all of the string "OBJXL." (including the period.

My code dynamically retries data in the Access interface, then creates a new Excel Workbook, Worksheet, populates the data, formats the data and Saves As to the user's network folder, under a folder with the report's name, and names the report with date/time plus the parameters the user used.

The code typically formats the report in many way.

So this code was optional to color code cells based on values in the row.
You will have to replace the intMaxRecordCount with some actual number of records in your Excel.
And, you will have to remove the comments (single quotes).
This should give you a head start on your solution.

  '    ------- Optional Color Code Cells based on value ---------------
  ' Not used in this report - However - if they want a value in a column highlighed (color) this is ready to go per meeting decision. Just uncomment
 'Debug.Print "Format cell by values"  ' Starts at F5 and goes to F + the number of records +5
  'Set MyPlage = objXL.Range("F5:F" & (intMaxRecordCount + 5))               ' add starter variables here
    'For Each Cell In MyPlage
        'If Cell.Value = "Requested" Then
            'Cell.Interior.ColorIndex = vbBlue
        'End If
        'If Cell.Value = "Final" Then
            'Cell.Interior.ColorIndex = vbYellow
        'End If
        'If Cell.Value = "County" Then
            'Cell.Interior.ColorIndex = 18
        'End If
        'If Cell.Value <> "State" And Cell.Value <> "Federal" And Cell.Value <> "County" And Cell.Value <> "Miscellaneous" Then
            'Cell.Interior.ColorIndex = xlNone
        'End If
    'Next
  'Set MyPlage = Nothing
 '                      --------------------------------------   end optional color code cells based on value ------------
  ' color the rows and columns

If you appreciate this, just click on the Thanks

 

[bluenose76]

Rx,

thank you for your reply, however, have to be honest and say im a little confused.

the code i use elsewhere in my workbook works like a dream:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vValue As Variant
vValue = Target.Value
On Error Resume Next
If vValue = "P" Then
    Target.Interior.Color = RGB(0, 255, 0)
End If
If vValue = "R" Then
    Target.Interior.Color = RGB(205, 204, 153)
End If
If vValue = "C" Then
    Target.Interior.Color = RGB(153, 153, 255)
End If
If vValue = "RE" Then
    Target.Interior.Color = RGB(255, 102, 0)
End If
If vValue = "p" Then
    Target.Interior.Color = RGB(0, 255, 0)
End If
If vValue = "P" Then
    Target.Interior.Color = RGB(205, 204, 153)
End If
If vValue = "p" Then
    Target.Interior.Color = RGB(153, 153, 255)
End If
If vValue = "re" Then
    Target.Interior.Color = RGB(255, 102, 0)
End If
If vValue = "" Then
    Target.Interior.ColorIndex = xlNone
End If
If vValue = "A" Then
    Target.Interior.Color = RGB(225, 0, 0)
End If
If vValue = "a" Then
    Target.Interior.Color = RGB(225, 0, 0)
End If
End Sub

it would be nice to think i could use the same code above, but change the criteria to pick up when the cell reads 100%, 50% etc.. however i have tried this to no avail?

suggestions?

 

[Rx_]

Maybe this would be more to your style?

Public Sub MyPlageSub()
Dim MyPlage As range
Sheets("Sheet1").Select
Set MyPlage = range("E4:E12")               ' Pass in your actual range
    For Each cell In MyPlage
        Debug.Print "Cell value being evalutated is: " & cell.Value
        If cell.Value = "1" Then  ' 100%
            cell.Font.Color = vbBlue
        End If
        If cell.Value < 0.5 Then ' 50%
            cell.Font.Color = vbGreen
        End If
    Next
Set MyPlage = Nothing
End Sub

Look up the various color index here:
http://dmcritchie.mvps.org/excel/colors.htm

 

[bluenose76]

Maybe this would be more to your style?

Public Sub MyPlageSub()
Dim MyPlage As range
Sheets("Sheet1").Select
Set MyPlage = range("E4:E12")               ' Pass in your actual range
    For Each cell In MyPlage
        Debug.Print "Cell value being evalutated is: " & cell.Value
        If cell.Value = "1" Then  ' 100%
            cell.Font.Color = vbBlue
        End If
        If cell.Value < 0.5 Then ' 50%
            cell.Font.Color = vbGreen
        End If
    Next
Set MyPlage = Nothing
End Sub

Look up the various color index here:
http://dmcritchie.mvps.org/excel/colors.htm

Rx,

i have attempted your latest code and cannot seen to make it work, i am obviously doing something wrong...?

looking at the range makes me curious. my page covers 6 months of data with one column representing one day. to repeat your code and specify the range for each and every clump, makes a lot of code... or an i missing something?

thank you for all your help with this

 

[Rx_]

This code ran from a Module in a Workbook that contained a Worksheet named "sheet 1"

The range was a demo, it does not cover every cell in a Workbook

You will need to change the worksheet name and the range to fit your need.