Need help in macro for color condtion

sksanjeev786

Board Regular
Joined
Aug 5, 2020
Messages
219
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: 12

Some videos you may like

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

cooper645

Well-known Member
Joined
Nov 16, 2013
Messages
622
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
  3. Mobile
  4. Web
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
 

sksanjeev786

Board Regular
Joined
Aug 5, 2020
Messages
219
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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

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: 11

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
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
 

sksanjeev786

Board Regular
Joined
Aug 5, 2020
Messages
219
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

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

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

cooper645

Well-known Member
Joined
Nov 16, 2013
Messages
622
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
  3. Mobile
  4. Web

sksanjeev786

Board Regular
Joined
Aug 5, 2020
Messages
219
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

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.

Sure thanks for the update sir:)
 

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
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:

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
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
 

sksanjeev786

Board Regular
Joined
Aug 5, 2020
Messages
219
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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


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: 3

Watch MrExcel Video

Forum statistics

Threads
1,126,986
Messages
5,621,992
Members
415,873
Latest member
fuulhouse

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
Top