Color only a part of cell using Macro or REPT Function



Query Source   : Excel Macros Google Group
Solution Type   : VBA Macro
Query by         : ExcelUser777
Solution by       : Ashish Jain (MCAS; MCA; Lead Trainer, Success Electrons)


Query / Problem:
HI
Basically i'd like to only show coloring in part of a cell, so for example
Cell A1 is grey only 33% of the cell is grey -I'd like to color one cell grey 33%. I have several cells to color, different percentages. Once I see one macro I can create the other percentages. Is that possible with a macro?
Appreciate all your help.
Excel 2003 preferably
Thanks,
ExcelUser777


Solution:
1. Using Macro


i)   Select the range (It should be in terms of percentage, else change the following code accordingly.)
ii)  Press Alt+F11.
iii) Paste the following code in Code window.
iv) Run the macro and enjoy.

Code:
Sub Color_Part_of_Cell()
Dim myCell As Range
For Each myCell In Selection.Cells
    'Set TextBox Left Position
    x = myCell.Left + 1
    'Set TextBox Top Postion
    y = myCell.Top + 1
    'Set TextBox Width
    width_ = myCell.Value * 58
    'Set TextBox Value
    text_ = myCell.Value * 100 & "%"
   
    'Add TextBox
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, x, y, width_, 10).Select
   
    'Add Text to Textbox
    Selection.Characters.Text = text_
   
    'Fill Textbox with Gray Color
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 22
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 22
   
    'Change Font
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 8
    End With
   
    'Align Text in Textbox
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
   
    'Clear contents of Cell
    myCell.Clear
Next
End Sub




2. Using REPT Function

i) Use REPT function to repeat the pipe symbol, | as displayed in formula box Below.





Comments

Anonymous said…
The author forgot to set some variables to code above. Here is the revised code for 2003/2007 compatibility. Once you set you cells to look like the table provided above, then select the range with your mouse and run the code.

Sub Color_Part_of_Cell()
Dim myCell As Range, x As Double, y As Double, width_ As Integer, text_ As String

For Each myCell In Selection.Cells
'Set TextBox Left Position
x = myCell.Left + 1
'Set TextBox Top Postion
y = myCell.Top + 1
'Set TextBox Width
width_ = myCell.Value * 58
'width_ = myCell.Value * 58
'Set TextBox Value
text_ = myCell.Value * 100 & "%"

'Add TextBox
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, x, y, width_, 10).Select

'Add Text to Textbox
Selection.Characters.Text = text_

'Fill Textbox with Gray Color
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 22
Selection.ShapeRange.Line.ForeColor.SchemeColor = 22

'Change Font
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
End With

'Align Text in Textbox
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

'Clear contents of Cell
myCell.Clear
Next
End Sub

-by ERROR
Anonymous said…
I'd like to see part of the cell coloring without adding text box - "ActiveSheet.Shapes.AddTextbox".
Do you have an idea how to do this?
Anonymous said…
Is this same functionality feasible in PowerPoint vba macro?