CODEWITHSUNDEEP
vbaexcelconditional-formatting
Jonh
Jonh

Reputation: 111

VBA Format a Number in a loop for conditional formatting

I'm trying to colour code the max and min numbers on an Excel Chart. Following Peltiertech.com ideas I have a code that works. The problem however is that the numbers in Excel are formatted to have no decimal points (FormulaRange4.NumberFormat = "0"). The values being checked out by my VBA formula are NOT formatted. As a result my "min" is being read as 265.875 instead of a rounded 266. As a result of this the code is unable to find my minimum.

Does anyone have a solution to this? Below is the code. the sub routine is fairly large but the portion of concern starts with "'Sub wiseowltutorial()"

Set FormulaRange3 = .Range(.Cells(d, c + 2), .Cells(r - 1, c + 3))
FormulaRange3.NumberFormat = "0"
Set FormulaRange4 = .Range(.Cells(d, c + c + 3), .Cells(r - 1, c + c + 3))
FormulaRange4.NumberFormat = "0"
Set SelectRanges = Union(FormulaRange3, FormulaRange4)

SelectRanges.Select
ActiveSheet.Shapes.AddChart.Select
With ActiveChart
.Type = xlColumn
.HasTitle = True
.ChartTitle.Text = "Individual Employee Productivity"
.ChartTitle.Font.Bold = True
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Text = "Employees"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Text = "Widgets Produced"
.Axes(xlValue).MajorGridlines.Delete
.ApplyDataLabels
.Legend.Delete
.Parent.Name = "Individual Employee Productivity"

End With

End With 'End Sub

'Sub fromYouTubewiseowltutorial() 'find the proper way to highlight the most and least productive person or person per team

Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim ppTextbox As PowerPoint.Shape
Dim ppiPoint As Long
Dim ppvValues As Variant
Dim pprValue As Range

Dim lMax As Long
lMax = WorksheetFunction.Max(FormulaRange4)
Dim lMin As Long
lMin = WorksheetFunction.Min(FormulaRange4)

With ActiveChart.SeriesCollection(1)
    ppvValues = .Values
    For ppiPoint = 1 To UBound(ppvValues)
            If ppvValues(ppiPoint) = lMax Then
            .Points(ppiPoint).Format.Fill.ForeColor.RGB = RGB(0, 225, 0)
            End If
            If ppvValues(ppiPoint) = lMin Then
            .Points(ppiPoint).Format.Fill.ForeColor.RGB = RGB(225, 0, 0)
            End If

        Next
 End With

Thanks :)

Upvotes: 2

Views: 697

Answers (1)

Fadi
Fadi

Reputation: 3322

Try to use Round():

If Round(ppvValues(ppiPoint),0) = Round(lMax,0) Then
...
...
If Round(ppvValues(ppiPoint),0) = Round(lMin,0) Then

Upvotes: 1

Related Questions