- Joined
- Sep 15, 2005
- Messages
- 2
- Reaction score
- 0
I am trying to create this chart with dates on x axis and clustered bar chart on y axis showing availability of equipment(Rented,Quoted,Available) in different colours.
I tried to write the following macro for the above requirement but i cant get x axis to show the dates and the bar chart on y axis does not show different colours for different status of equipment.
The data is as follows
A1:28882 C1:Status
A2:09/09/2005 C2:Rented
A3:09/16/2005 C3:Quoted
In the above paragraph, 28882 is an equipment unit,which has status Rented from 9 Sep to 15 Sep
and status Quoted from 16 Sep till 30 Sep.
The macro is as follows -----------------
Sub MakeRental()
Dim i As Integer
Dim MinVal As Date
Dim MaxVal As Date
Worksheets("Rental").Select
Worksheets("Rental").Range("A2:A3").Select
'Selection.DateFormat = "mm/dd/yyyy"
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="Rental"
ActiveChart.ChartType = xlBarClustered
ActiveChart.SetSourceData Source:=Sheets("Rental").Range("R10"), PlotBy:=xlRows
ActiveChart.SetSourceData Source:=Sheets("Rental").Range("A1:A3"), PlotBy:=xlRows
MinVal = #9/9/2005#
MaxVal = #9/25/2005#
With ActiveSheet.ChartObjects(1).Chart.Axes(xlValue)
.MinimumScale = MinVal
.MaximumScale = MaxVal
End With
With ActiveChart
.HasLegend = True
.Legend.Select
Selection.Position = xlRight
.SeriesCollection(1).Name = "=""Rented"""
With ActiveChart.SeriesCollection.NewSeries
.Name = "Quoted"
.XValues = ActiveSheet.Range("A2:A3")
End With
With ActiveChart.SeriesCollection.NewSeries
.Name = "Available"
End With
.HasDataTable = False
.HasTitle = True
.ChartTitle.Characters.Text = "Rental Availability Chart"
End With
ActiveChart.SeriesCollection(1).Select
With ActiveChart.ChartGroups(1)
.Overlap = 100
.GapWidth = 150
.HasSeriesLines = False
End With
For i = 1 To 2
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
If Worksheets("Rental").Cells(i + 1, 3) = "Rented" Then
.ColorIndex = 4 'green
Else
If Worksheets("Rental").Cells(i + 1, 3) = "Quoted" Then
.ColorIndex = 3 'red
End If
End If
.Pattern = xlSolid
End With
ActiveChart.ChartGroups(1).SeriesCollection(1).PlotOrder = 1
Next i
End Sub
---------------------------------------------------
Regards,
I tried to write the following macro for the above requirement but i cant get x axis to show the dates and the bar chart on y axis does not show different colours for different status of equipment.
The data is as follows
A1:28882 C1:Status
A2:09/09/2005 C2:Rented
A3:09/16/2005 C3:Quoted
In the above paragraph, 28882 is an equipment unit,which has status Rented from 9 Sep to 15 Sep
and status Quoted from 16 Sep till 30 Sep.
The macro is as follows -----------------
Sub MakeRental()
Dim i As Integer
Dim MinVal As Date
Dim MaxVal As Date
Worksheets("Rental").Select
Worksheets("Rental").Range("A2:A3").Select
'Selection.DateFormat = "mm/dd/yyyy"
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="Rental"
ActiveChart.ChartType = xlBarClustered
ActiveChart.SetSourceData Source:=Sheets("Rental").Range("R10"), PlotBy:=xlRows
ActiveChart.SetSourceData Source:=Sheets("Rental").Range("A1:A3"), PlotBy:=xlRows
MinVal = #9/9/2005#
MaxVal = #9/25/2005#
With ActiveSheet.ChartObjects(1).Chart.Axes(xlValue)
.MinimumScale = MinVal
.MaximumScale = MaxVal
End With
With ActiveChart
.HasLegend = True
.Legend.Select
Selection.Position = xlRight
.SeriesCollection(1).Name = "=""Rented"""
With ActiveChart.SeriesCollection.NewSeries
.Name = "Quoted"
.XValues = ActiveSheet.Range("A2:A3")
End With
With ActiveChart.SeriesCollection.NewSeries
.Name = "Available"
End With
.HasDataTable = False
.HasTitle = True
.ChartTitle.Characters.Text = "Rental Availability Chart"
End With
ActiveChart.SeriesCollection(1).Select
With ActiveChart.ChartGroups(1)
.Overlap = 100
.GapWidth = 150
.HasSeriesLines = False
End With
For i = 1 To 2
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
If Worksheets("Rental").Cells(i + 1, 3) = "Rented" Then
.ColorIndex = 4 'green
Else
If Worksheets("Rental").Cells(i + 1, 3) = "Quoted" Then
.ColorIndex = 3 'red
End If
End If
.Pattern = xlSolid
End With
ActiveChart.ChartGroups(1).SeriesCollection(1).PlotOrder = 1
Next i
End Sub
---------------------------------------------------
Regards,