Need help in macro for color condtion

S

sksanjeev786

Well-known Member
Joined
Aug 5, 2020
Messages
881
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi Team,

I need Macro for the attached chart with condition like
If score is =>5 need to shade red color else black outline
if score is =<-5 need to shade Red border else grey outline

Can anyone help me with this?

Thanks in advance.

Regards,
Sanjeev
 

Attachments

  • Bips chart.png
    Bips chart.png
    23.3 KB · Views: 15

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Sort by date Sort by votes
This is as you requested but to me doesn't work well with the three border colour options

VBA Code: 
Sub ShadeAndColor()
 Dim Rng As Range, c As Range
 
Set Rng = Application.InputBox("Select a range", "Get User Range", Type:=8)
 
For Each c In Rng
If c.Value >= 5 Then
    c.Interior.ColorIndex = 3
Else
    c.BorderAround ColorIndex:=1
If c.Value <= -5 Then
    c.BorderAround ColorIndex:=3
Else
    c.BorderAround ColorIndex:=15
End If
End If
Next c

End Sub
 
Upvote 0
cooper645 said:
This is as you requested but to me doesn't work well with the three border colour options

VBA Code: 
Sub ShadeAndColor()
Dim Rng As Range, c As Range

Set Rng = Application.InputBox("Select a range", "Get User Range", Type:=8)

For Each c In Rng
If c.Value >= 5 Then
    c.Interior.ColorIndex = 3
Else
    c.BorderAround ColorIndex:=1
If c.Value <= -5 Then
    c.BorderAround ColorIndex:=3
Else
    c.BorderAround ColorIndex:=15
End If
End If
Next c

End Sub
Click to expand...

Thank you sir for the above help.

while I was applying to the chart I am getting an error could you please check and help me out.

Thank you in advance.

Regards,
Sanjeev
 

Attachments

  • error 2.png
    error 2.png
    30.8 KB · Views: 12
Upvote 0
Hi
VBA Code: 
Sub color_condtion()
    
    With Range("B2:H15")
            .FormatConditions.Delete
            .FormatConditions.AddDatabar
            .FormatConditions(.FormatConditions.Count).ShowValue = True
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
                With .FormatConditions(1)
                    .MinPoint.Modify newtype = -5
                    .MaxPoint.Modify newtype = 5
                End With
            With .FormatConditions(1).BarColor
                .Color = RGB(111, 111, 111)
                .TintAndShade = 0
            End With
            .FormatConditions(1).BarFillType = xlDataBarFillGradient
            .FormatConditions(1).Direction = xlContext
            .FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
            .FormatConditions(1).BarBorder.Type = xlDataBarBorderSolid
            .FormatConditions(1).NegativeBarFormat.BorderColorType = _
                xlDataBarColor
            With .FormatConditions(1).BarBorder.Color
                .Color = RGB(111, 111, 111)
                .TintAndShade = 0
            End With
            .FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
            With .FormatConditions(1).AxisColor
                .Color = RGB(0, 0, 0)
                .TintAndShade = 0
            End With
            With .FormatConditions(1).NegativeBarFormat.Color
                .Color = RGB(255, 0, 0)
                .TintAndShade = 0
            End With
            With .FormatConditions(1).NegativeBarFormat.BorderColor
                .Color = RGB(255, 0, 0)
                .TintAndShade = 0
            End With
    
End With

End Sub

Book1
ABCDEFGH
1
2I would recommend to my friends and family -42-4-3-5-2
3Works better than other brands
4Improves the Lcok and feel of my skin 5
5Is a brand I trust
6Leaves skin feeling hydrated
7Is good value for tie money -55
8Is a brand that shares my values
9Gcod for sensitive skin 54-5
10Offers the most advanced formulas and technology
11Contains natural ingredients that really work 42-3
12Helps heal and relieve skin issues
13Are clinicalty proven to work -5
14Is socially and environmentally responsible
15Is recommended by doctors and dermatobogists
Sheet2
Cells with Conditional Formatting
CellConditionCell FormatStop If True
B2:H15Other TypeDataBarNO
 
Upvote 0
Dossfm0q said:
Hi
VBA Code: 
Sub color_condtion()
   
    With Range("B2:H15")
            .FormatConditions.Delete
            .FormatConditions.AddDatabar
            .FormatConditions(.FormatConditions.Count).ShowValue = True
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
                With .FormatConditions(1)
                    .MinPoint.Modify newtype = -5
                    .MaxPoint.Modify newtype = 5
                End With
            With .FormatConditions(1).BarColor
                .Color = RGB(111, 111, 111)
                .TintAndShade = 0
            End With
            .FormatConditions(1).BarFillType = xlDataBarFillGradient
            .FormatConditions(1).Direction = xlContext
            .FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
            .FormatConditions(1).BarBorder.Type = xlDataBarBorderSolid
            .FormatConditions(1).NegativeBarFormat.BorderColorType = _
                xlDataBarColor
            With .FormatConditions(1).BarBorder.Color
                .Color = RGB(111, 111, 111)
                .TintAndShade = 0
            End With
            .FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
            With .FormatConditions(1).AxisColor
                .Color = RGB(0, 0, 0)
                .TintAndShade = 0
            End With
            With .FormatConditions(1).NegativeBarFormat.Color
                .Color = RGB(255, 0, 0)
                .TintAndShade = 0
            End With
            With .FormatConditions(1).NegativeBarFormat.BorderColor
                .Color = RGB(255, 0, 0)
                .TintAndShade = 0
            End With
   
End With

End Sub

Book1
ABCDEFGH
1
2I would recommend to my friends and family -42-4-3-5-2
3Works better than other brands
4Improves the Lcok and feel of my skin 5
5Is a brand I trust
6Leaves skin feeling hydrated
7Is good value for tie money -55
8Is a brand that shares my values
9Gcod for sensitive skin 54-5
10Offers the most advanced formulas and technology
11Contains natural ingredients that really work 42-3
12Helps heal and relieve skin issues
13Are clinicalty proven to work -5
14Is socially and environmentally responsible
15Is recommended by doctors and dermatobogists
Sheet2
Cells with Conditional Formatting
CellConditionCell FormatStop If True
B2:H15Other TypeDataBarNO
Click to expand...

Hello sir,

Still, I am getting error in PPT

please find Screenshot of macro and ppt.

Is there is any way to share the PPT chart with you..

Thanks.

Regards,
Sanjeev
 

Attachments

  • errr 3.png
    errr 3.png
    32.2 KB · Views: 6
  • errr4.png
    errr4.png
    30.4 KB · Views: 7
Upvote 0
Upvote 0
cooper645 said:
I think your issue lies with VBA being in break mode rather than with any of the codes.

Rather than typing a out a lengthy how to that's already written, please see here to reset; What is the Error "Can't Execute Code in Break Mode"? - VBA and VB.Net Tutorials, Education and Programming Services

Also it looks like your using powerpoint. This is an excel based solution, not being familiar with ppt code, your mileage may vary with these codes.
Click to expand...

Sure thanks for the update sir:)
 
Upvote 0
What about
Feedback Please
copy and Paste into Power Point Module
VBA Code: 
Public Sub PPT_color_condtion()

Dim Shp As Shape
Dim Prst As Presentation
Dim Sld As Slide
Dim Tbl As Table
Dim Rw As Long, Cl As Long
    Set Prst = ActivePresentation
    Set Sld = Prst.Slides(1)
    Set Shp = Sld.Shapes(1)
    Set Tbl = Shp.Table
 
    With Tbl
 
    For Rw = 1 To .Rows.Count
 
         For Cl = 1 To .Columns.Count
            With .Cell(Rw, Cl)
         
                 TXT = .Shape.TextFrame.TextRange.Text
                    If Rw < 2 Then
                    ' Header ,Title
                        With .Shape.Fill
                        .ForeColor.RGB = RGB(47, 117, 181)
                        End With
                 
                    Else
                        If Rw Mod 2 = 0 Then
                            With .Shape.Fill
                            .ForeColor.RGB = RGB(189, 215, 238)
                            .BackColor.RGB = RGB(189, 215, 238)
     
                            End With
                        Else
                     
                        End If
                            If Cl > 1 And TXT <> "" And (TXT) <= -5 Then
                                With .Shape.Fill
                                .TwoColorGradient msoGradientVertical, 1
                                    If Rw Mod 2 = 0 Then
                                        .ForeColor.RGB = RGB(189, 215, 238)
                                        .BackColor.RGB = RGB(189, 215, 238)
                                        .GradientStops.Insert RGB(189, 215, 238), 0.51, 0
                                    Else
                                        .ForeColor.RGB = RGB(255, 255, 255)
                                        .BackColor.RGB = RGB(255, 255, 255)
                                        .GradientStops.Insert RGB(255, 255, 255), 0.51, 0
                                    End If
                                 
                                    .GradientStops.Insert RGB(255, 0, 0), 0.5, 0
                                    .GradientStops.Insert RGB(255, 0, 0), 0, 0
                                End With
                            ElseIf Cl > 1 And TXT <> "" And (TXT) >= -5 Then
                                With .Shape.Fill
                                .TwoColorGradient msoGradientVertical, 1
                                    If Rw Mod 2 = 0 Then
                                        .ForeColor.RGB = RGB(189, 215, 238)
                                        .BackColor.RGB = RGB(189, 215, 238)
                                        .GradientStops.Insert RGB(189, 215, 238), 0.51, 0
                                    Else
                                        .ForeColor.RGB = RGB(255, 255, 255)
                                        .BackColor.RGB = RGB(255, 255, 255)
                                        .GradientStops.Insert RGB(255, 255, 255), 0.51, 0
                                    End If
                                 
                                    .GradientStops.Insert RGB(200, 200, 200), 0.5, 0
                                    .GradientStops.Insert RGB(200, 200, 200), 0, 0
                                End With
                         
                            End If
                 
                    End If
            End With
         Next 'Cl
 
    Next 'RW
 
    End With

End Sub

Power Point
Cond.gif

for copy
Book1
ABCDEFGH
1
2I would recommend to my friends and family -41-4-3-6-20
3Works better than other brands 1-2-1-1-10-1
4Application.ActivePresentation.Slides(1)-3-3-4-4-2-10
5Is a brand I trust -70-5-4-30-3
6Leaves skin feeling hydrated -3-3-3-12-1-4
7Is good value for tie money -4-4-5-20-1
8Is a brand that shares my values -53-5-5-5-16
9Gcod for sensitive skin 7-1753-2-2
10Offers the most advanced formulas and technology 5-421111
11Contains natural ingredients that really work -421-3-3-1-37
12Helps heal and relieve skin issues 4-33868-4
13Are clinicalty proven to work 8-58733-5
14Is socially and environmentally responsible -516-3-4-2-213
15Is recommended by doctors and dermatobogists 16-7161392-5
Sheet1
 
Last edited:
Upvote 0
May, this what you want

PLZ feedback

VBA Code: 
Public Sub PPT_color_condtion()

Dim Shp As Shape
Dim Prst As Presentation
Dim Sld As Slide
Dim Tbl As Table
Dim Rw As Long, Cl As Long
    Set Prst = ActivePresentation
    Set Sld = Prst.Slides(1)
    Set Shp = Sld.Shapes(1)
    Set Tbl = Shp.Table
 
    With Tbl
 
    For Rw = 1 To .Rows.Count
 
         For Cl = 1 To .Columns.Count
            With .Cell(Rw, Cl)
        
                 TXT = .Shape.TextFrame.TextRange.Text
                    If Rw < 2 Then
                    ' Header ,Title
                        With .Shape.Fill
                        .ForeColor.RGB = RGB(47, 117, 181)
                        End With
                
                    Else
                        If Rw Mod 2 = 0 Then
                            With .Shape.Fill
                            .ForeColor.RGB = RGB(189, 215, 238)
                            .BackColor.RGB = RGB(189, 215, 238)
    
                            End With
                        Else
                    
                        End If
                            If Cl > 1 And TXT <> "" And (TXT) <= 0 Then
                                If TXT < 0 Then
                                    N = (1 - (TXT / 100) * -1)
                                    N = N - 0.1
                                        Else
                                    N = 0.99
                                End If
                                With .Shape.Fill
                                .TwoColorGradient msoGradientVertical, 1
                                    If TXT <= -5 Then
                                    Clr = RGB(255, 0, 0)
                                    Else
                                    Clr = RGB(150, 150, 150)
                                    End If
                                    If Rw Mod 2 = 0 Then
                                    
                                        .ForeColor.RGB = RGB(255, 255, 255)
                                        .BackColor.RGB = RGB(255, 255, 255)
                                        .GradientStops.Insert RGB(189, 215, 238), N, 0
                                    Else
                                        .ForeColor.RGB = RGB(255, 255, 255)
                                        .BackColor.RGB = RGB(255, 255, 255)
                                        .GradientStops.Insert RGB(255, 255, 255), N, 0
                                    End If
                                
                                    .GradientStops.Insert Clr, 0.99, 0
                                    If N + 0.01 >= 0.99 Then N = 0.99
                                    .GradientStops.Insert Clr, N, 0
                                End With
                            ElseIf Cl > 1 And TXT <> "" And (TXT) >= 0 Then
                            N = (TXT / 100) + 0.1
                                    If TXT >= 5 Then
                                    Clr = RGB(255, 0, 0)
                                    Else
                                    Clr = RGB(150, 150, 150)
                                    End If
                            
                                With .Shape.Fill
                                .TwoColorGradient msoGradientVertical, 1
                                    If Rw Mod 2 = 0 Then
                                        .ForeColor.RGB = RGB(189, 215, 238)
                                        .BackColor.RGB = RGB(189, 215, 238)
                                        .GradientStops.Insert RGB(189, 215, 238), N + 0.01, 0
                                    Else
                                        .ForeColor.RGB = RGB(255, 255, 255)
                                        .BackColor.RGB = RGB(255, 255, 255)
                                        .GradientStops.Insert RGB(255, 255, 255), N + 0.01, 0
                                    End If
                                
                                    .GradientStops.Insert Clr, N, 0
                                    .GradientStops.Insert Clr, 0, 0
                                End With
                        
                            End If
                
                    End If
            End With
         Next 'Cl
 
    Next 'RW
 
    End With

End Sub

PPTCond.gif
 
Upvote 0
Dossfm0q said:
May, this what you want

PLZ feedback

VBA Code: 
Public Sub PPT_color_condtion()

Dim Shp As Shape
Dim Prst As Presentation
Dim Sld As Slide
Dim Tbl As Table
Dim Rw As Long, Cl As Long
    Set Prst = ActivePresentation
    Set Sld = Prst.Slides(1)
    Set Shp = Sld.Shapes(1)
    Set Tbl = Shp.Table

    With Tbl

    For Rw = 1 To .Rows.Count

         For Cl = 1 To .Columns.Count
            With .Cell(Rw, Cl)
       
                 TXT = .Shape.TextFrame.TextRange.Text
                    If Rw < 2 Then
                    ' Header ,Title
                        With .Shape.Fill
                        .ForeColor.RGB = RGB(47, 117, 181)
                        End With
               
                    Else
                        If Rw Mod 2 = 0 Then
                            With .Shape.Fill
                            .ForeColor.RGB = RGB(189, 215, 238)
                            .BackColor.RGB = RGB(189, 215, 238)
   
                            End With
                        Else
                   
                        End If
                            If Cl > 1 And TXT <> "" And (TXT) <= 0 Then
                                If TXT < 0 Then
                                    N = (1 - (TXT / 100) * -1)
                                    N = N - 0.1
                                        Else
                                    N = 0.99
                                End If
                                With .Shape.Fill
                                .TwoColorGradient msoGradientVertical, 1
                                    If TXT <= -5 Then
                                    Clr = RGB(255, 0, 0)
                                    Else
                                    Clr = RGB(150, 150, 150)
                                    End If
                                    If Rw Mod 2 = 0 Then
                                   
                                        .ForeColor.RGB = RGB(255, 255, 255)
                                        .BackColor.RGB = RGB(255, 255, 255)
                                        .GradientStops.Insert RGB(189, 215, 238), N, 0
                                    Else
                                        .ForeColor.RGB = RGB(255, 255, 255)
                                        .BackColor.RGB = RGB(255, 255, 255)
                                        .GradientStops.Insert RGB(255, 255, 255), N, 0
                                    End If
                               
                                    .GradientStops.Insert Clr, 0.99, 0
                                    If N + 0.01 >= 0.99 Then N = 0.99
                                    .GradientStops.Insert Clr, N, 0
                                End With
                            ElseIf Cl > 1 And TXT <> "" And (TXT) >= 0 Then
                            N = (TXT / 100) + 0.1
                                    If TXT >= 5 Then
                                    Clr = RGB(255, 0, 0)
                                    Else
                                    Clr = RGB(150, 150, 150)
                                    End If
                           
                                With .Shape.Fill
                                .TwoColorGradient msoGradientVertical, 1
                                    If Rw Mod 2 = 0 Then
                                        .ForeColor.RGB = RGB(189, 215, 238)
                                        .BackColor.RGB = RGB(189, 215, 238)
                                        .GradientStops.Insert RGB(189, 215, 238), N + 0.01, 0
                                    Else
                                        .ForeColor.RGB = RGB(255, 255, 255)
                                        .BackColor.RGB = RGB(255, 255, 255)
                                        .GradientStops.Insert RGB(255, 255, 255), N + 0.01, 0
                                    End If
                               
                                    .GradientStops.Insert Clr, N, 0
                                    .GradientStops.Insert Clr, 0, 0
                                End With
                       
                            End If
               
                    End If
            End With
         Next 'Cl

    Next 'RW

    End With

End Sub

View attachment 24339
Click to expand...


Hi Sir,

I have tried with both macro and getting the same result like not getting color on the chart and the table got shaded. please see the screenshot for reference.
As I need color only on the bar chart baseed on the condition.

Thanks in advance or your hard work sir:).

Thanks.

Regards,
Sanjeev
 

Attachments

  • errr5.png
    errr5.png
    23.5 KB · Views: 4
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Need to copy Table from File A to to File B (Client PPT)
Replies
0
Views
54
sksanjeev786
S
N
  • Question
Stacked Chart to show value and status YTD
Replies
2
Views
277
neilo1969
N
S
  • Question
Query on Macro
Replies
0
Views
140
sksanjeev786
S
M
  • Question
VBA Event help, change shape of color as per option selections
Replies
5
Views
193
Jaafar Tribak
Jaafar Tribak
T
  • Solved
macro for formatting columns if values are greater than or equal to reference cells
Replies
7
Views
423
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,606
Messages
6,120,478
Members
448,967
Latest member
visheshkotha

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top