Macro: Conditional Formatting

sksanjeev786

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

Need your help in the below macro. As Macro is working perfectly and need to add

As of now below conditions is less than 5 and more than 5 only but I

I need to add conditions between
5 to 9.99 as Green
-5 to -9.99 as Light Red
=10 and Above Dark Blue
=-10 and below Dark Red

VBA Code:
Sub colorformat()

   Dim s As Slide
   Dim oSh As Shape
   Dim oTbl As Table
   Dim lRow As Long
   Dim lCol As Long
    Dim cell As ReflectionFormat
  
   For Each s In ActivePresentation.Slides
       For Each oSh In s.Shapes
           If oSh.HasTable Then
               Set oTbl = oSh.Table
               For lRow = 2 To oTbl.Rows.Count
                   For lCol = 3 To oTbl.Columns.Count
                     
                       If IsNumeric(oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange) = True Then
                      
                       If oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange >= 5 Then
                       oTbl.cell(lRow, lCol).Shape.Fill.ForeColor.RGB = RGB(102, 228, 102)
                       oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
                       oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange.Font.Bold = True
                        Else
                        If oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange <= -5 Then
                        oTbl.cell(lRow, lCol).Shape.Fill.ForeColor.RGB = RGB(237, 102, 102)
                        oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
                        oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange.Font.Bold = True
                        Else
                        If oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange = Null Then
                        End If

                        End If
                        End If
                        End If
                       
                   Next
               Next
           End If
       Next    ' Shape
   Next s
End Sub
 

Attachments

  • 1638199725756.png
    1638199725756.png
    149.7 KB · Views: 21
Last edited by a moderator:

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Not sure what your doing here but if you have a lot of if statements I would suggest use Case

Here in this example we are looking at Range("A1").value

If the value is from 1 to 5
If the value is from 6 to 12

If the value is "Alpha"
If the value is "Bravo" or "Charlie" Or "Delta"
Or if none of these:
VBA Code:
Sub My_Select_Cas()
'Modified 11/29/2021  4:39:36 PM  EST
Application.ScreenUpdating = False

Select Case Range("A1").Value

    Case 1 To 5: Range("B1").Value = "Yes"
    Case 6 To 12: Range("B1").Value = "No"
    Case "Alpha": Range("B1").Value = "Bravo"
    Case "Bravo", "Charlie", "Delta": Range("B1").Value = "Echo"
        Case Else
            Range("B1").Value = "Nothing"

End Select
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Not sure what your doing here but if you have a lot of if statements I would suggest use Case

Here in this example we are looking at Range("A1").value

If the value is from 1 to 5
If the value is from 6 to 12

If the value is "Alpha"
If the value is "Bravo" or "Charlie" Or "Delta"
Or if none of these:
VBA Code:
Sub My_Select_Cas()
'Modified 11/29/2021  4:39:36 PM  EST
Application.ScreenUpdating = False

Select Case Range("A1").Value

    Case 1 To 5: Range("B1").Value = "Yes"
    Case 6 To 12: Range("B1").Value = "No"
    Case "Alpha": Range("B1").Value = "Bravo"
    Case "Bravo", "Charlie", "Delta": Range("B1").Value = "Echo"
        Case Else
            Range("B1").Value = "Nothing"

End Select
Application.ScreenUpdating = True
End Sub


Hi,

Thanks for your time in this

The above macro i have provided is working well only I need to add logical conditional

5 to 9.99 as Green (Need macro line for this )
-5 to -9.99 as Light Red (Need macro line for this )
=10 and Above Dark Blue (Done)
=-10 and below Dark Red (Done)

=10 and Above""If oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange >= 10 Then""
=10 and below ""If oTbl.cell(lRow, lCol).Shape.TextFrame.TextRange <= -10 Then""
5 to 9.99 as Green (Need macro line for this ) " "
-5 to -9.99 as Light Red (Need macro line for this )" "

Let me know if you need more information on this

Regards,
Sanjeev
 
Upvote 0

Forum statistics

Threads
1,223,958
Messages
6,175,636
Members
452,662
Latest member
Aman1997

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