lines/bar chart- on max valued bar, change color
I have the code below. Green bars and 80% yellow line and 90% red line. You
will also see I have the "max" value. I'd like that max column to be other
than the set green for all the bars. I set the colors near the end of the
program. I've looked at some of the examples at the support site, but I'm not
sure if any fits me. Thanks.
C O D E B E L O W...............
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 3/12/2004 by bkondos
'
' 60 min avg cpu but weekly 8 hr days for 5 days<<<<<<<<<<<<<<<
ChDir "H:\"
Workbooks.OpenText Filename:="H:\sel60minsweek.txt", Origin:=437,
StartRow:=1, _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote,
ConsecutiveDelimiter _
:=False, Tab:=True, Semicolon:=False, Comma:=True, Space:=False, _
Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True
Columns("A:A").Select
Selection.NumberFormat = "m/d/yy h:mm;@"
Columns("B:B").Select
Selection.NumberFormat = "0.00"
Dim rng As Range
Set rng = ActiveSheet.Range(ActiveSheet.Cells(1, 1), _
ActiveSheet.Cells(1, 1).End(xlDown))
rng.Offset(0, 3).Value = 80
rng.Offset(0, 4).Value = 90
Columns("D:D").Select
Selection.NumberFormat = "0.00"
Columns("E:E").Select
Selection.NumberFormat = "0.00"
' 91 and "f" is to thicken up the bar
rng.Offset(0, 5).Value = 91
Columns("F:F").Select
Selection.NumberFormat = "0.00"
' 2 lines below: move into cell K1, the last cell of a variable column
length A
Range("K1").Select
ActiveCell.Formula = "=offset($A$1,counta(A:A)-1,0)"
' 2 lines below: move to cell K2, only the 1st 8 bytes of K1 (startpos and
length)
Range("K2").Select
ActiveCell.Formula = "=mid(K1, 1,10)"
' 5 lines copy cell k2 to k3, then drop /es
Range("K2").Select
Selection.Copy
Range("K3").Select
ActiveSheet.Paste
ActiveCell.Value = Replace(ActiveCell.Value, "/", "")
Range("G1").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(C[-5])"
Range("G2").Select
ActiveCell.FormulaR1C1 = "avg"
Range("H1").Select
ActiveCell.FormulaR1C1 = "=MEDIAN(C[-6])"
Range("H2").Select
ActiveCell.FormulaR1C1 = "med"
Range("I1").Select
ActiveCell.FormulaR1C1 = "=max(C[-7])"
Range("I2").Select
ActiveCell.FormulaR1C1 = "max"
Range("I3").Select
ActiveCell.Formula = "=INDEX(A:A,MATCH(MAX(B:B),B:B,0))"
Range("I4").Select
ActiveCell.FormulaR1C1 = "whenmax"
Range("H2,A:A,B:B,C:C,D:D,E:E").Select
Range("E1").Activate
Charts.Add
ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:="Line -
Column"
' 2 lines below changed into variable cells with code below these 2
' ActiveChart.SetSourceData
Source:=Sheets("sel60minsweek").Range("A1:E20"), PlotBy _
' :=xlColumns
Dim myrange As Range
Set myrange =
Sheets("sel60minsweek").Range(Sheets("sel60minswee k").Range("a1"), _
Sheets("sel60minsweek").Range("e1").End(xlDown))
ActiveChart.SetSourceData Source:=myrange, _
PlotBy:=xlColumns
ActiveChart.Location Whe=xlLocationAsNewSheet
With ActiveChart
.HasTitle = True
' was below with mm/dd/yy and got replcaed with k2 cell for date
' .ChartTitle.Characters.Text = _
' "W.E MM/DD/YY MVSA HOURLY CPU BUSY FROM 9AM TO 5PM " & Chr(10) & "WEEKLY
AVERAGE% WEEKLY MEDIAN% "
.ChartTitle.Characters.Text = _
"W.E " & Worksheets(1).Range("k2").Value & " MVSA HOURLY CPU BUSY FROM 9AM
TO 5PM " & Chr(10) & " WEEKLY AVERAGE% WEEKLY MEDIAN%
HIGHEST HOURLY CPU
ENDING " & Worksheets(1).Range("i3").Value & " " &
Worksheets(1).Range("i1") & " %"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = _
"ENDING HOUR TIME"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "PERCENT"
.Axes(xlCategory, xlSecondary).HasTitle = False
.Axes(xlValue, xlSecondary).HasTitle = False
End With
ActiveChart.Legend.Select
Selection.Delete
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, _
Variant:=2, _
Degree:=0.231372549019608
With Selection
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 50
' With Selection.Interior
' .ColorIndex = 43
' .Pattern = xlSolid
End With
ActiveChart.SeriesCollection(3).Select
With Selection.Border
.ColorIndex = 57
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlAutomatic
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 9
.Shadow = False
End With
ActiveChart.SeriesCollection(4).Select
With Selection.Border
.ColorIndex = 3
.Weight = xlThick
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
ActiveChart.PlotArea.Select
With ActiveChart.TextBoxes.Add(337, 230, 48, 18)
.Select
.AutoSize = True
.Formula = "=sel60minsweek!$G$1"
End With
Selection.ShapeRange.IncrementLeft -11.44
Selection.ShapeRange.IncrementTop -203.49
ActiveChart.PlotArea.Select
With ActiveChart.TextBoxes.Add(387, 230, 48, 18)
.Select
.AutoSize = True
.Formula = "=sel60minsweek!$H$1"
End With
Selection.ShapeRange.IncrementLeft 104.2
Selection.ShapeRange.IncrementTop -203.49
With ActiveChart.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.ChartSize = xlFullPage
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.BlackAndWhite = False
.Zoom = 100
End With
ActiveChart.Deselect
' "H:\MY DOCUMENTS ON H DRIVE\WEEKLYCPUW.E.MMDDYY", FileFormat:=xlNormal, _
' " & Worksheets(1).Range("k2").Value & "
ChDir "H:\MY DOCUMENTS ON H DRIVE"
ActiveWorkbook.SaveAs Filename:= _
"H:\MY DOCUMENTS ON H DRIVE\WEEKLYCPUW.E." & Worksheets(1).Range("k3").Value
& ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
End Sub
--
BOB-THE-K
|