K
kishore
Hi.
I have made this macro to Plot a graph depeding upon the values in a
sheet specified by the user. I made this macro to run only if there are
values in A09, A10, A11, A12, A13. Can anyone pls suggest me where I am
doing wrong. There are 6 series to plot right now, which I will
increase to 10.
Even if ther is no value it must plot one series.
Also I am observing if there is only one sereis to plot it shows the
legend in bottom for those not present.
Pls help!!...Thanks in Advance
Sub make_graph_new()
'Macro by Kishore Maheshwari
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim workb As Workbook
Dim file_name, message_window, title_window, line_name As String
Dim lrow, lcol As Integer
Dim rng As Range
Dim rng_line As Variant
Dim shCount As Integer
Dim mystr As String
Dim mywks, wks As Worksheet
Dim dir As Integer
Dim mydrive, myfeatherfile, mycurrentmeter, myexcel As String
With Worksheets("instructions")
mydrive = .Cells(3, 4)
myfeatherfile = .Cells(4, 4)
mycurrentmeter = .Cells(5, 4)
myexcel = .Cells(6, 4)
' Directory Location Defined
ChDrive (mydrive)
'Set mywks = ActiveSheet
mystr = InputBox("Please type the name of Worksheet to Read the
Data")
'Application.StatusBar = ".....now processing... " & mystr
Set wks = ActiveWorkbook.Worksheets(mystr)
wks.Activate
' Calculate the Values for Graph (series 1)
iLastrowc = Cells(Rows.Count, "B").End(xlUp).Row
rng_graphb = Range(Cells(22, "B"), Cells(iLastrowc, "B")).Address
rng_graphg = Range(Cells(22, "G"), Cells(iLastrowc, "G")).Address
' select the range from feather location (values for series2-5)
If Range("A9") <> "" Then
iLastrowf1 = Cells(Rows.Count, "J").End(xlUp).Row
rng_ff1 = Range(Cells(22, "I"), Cells(iLastrowf1, "I")).Address
rng_ff2 = Range(Cells(22, "H"), Cells(iLastrowf1, "H")).Address
line1 = Cells(9, 1)
End If
If Range("A10") <> "" Then
iLastrowf2 = Cells(Rows.Count, "P").End(xlUp).Row
rng_ff3 = Range(Cells(22, "O"), Cells(iLastrowf2, "O")).Address
rng_ff4 = Range(Cells(22, "N"), Cells(iLastrowf2, "N")).Address
line2 = Cells(10, 1)
End If
If Range("A11") <> "" Then
iLastrowf3 = Cells(Rows.Count, "V").End(xlUp).Row
rng_ff5 = Range(Cells(22, "U"), Cells(iLastrowf3, "U")).Address
rng_ff6 = Range(Cells(22, "T"), Cells(iLastrowf3, "T")).Address
line3 = Cells(11, 1)
End If
If Range("A12") <> "" Then
iLastrowf4 = Cells(Rows.Count, "AB").End(xlUp).Row
rng_ff7 = Range(Cells(22, "AA"), Cells(iLastrowf4, "AA")).Address
rng_ff8 = Range(Cells(22, "Z"), Cells(iLastrowf4, "Z")).Address
line4 = Cells(12, 1)
End If
If Range("A13") <> "" Then
iLastrowf5 = Cells(Rows.Count, "AH").End(xlUp).Row
rng_ff9 = Range(Cells(22, "AG"), Cells(iLastrowf5, "AG")).Address
rng_ff10 = Range(Cells(22, "AF"), Cells(iLastrowf5, "AF")).Address
line5 = Cells(13, 1)
End If
Charts.Add
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
ActiveChart.SeriesCollection(1).XValues = wks.Range(rng_graphb)
ActiveChart.SeriesCollection(1).Values = wks.Range(rng_graphg)
ActiveChart.SeriesCollection(1).Name = "=""Current Meter Fx"""
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.ColorIndex = 5
.Weight = xlThick
.LineStyle = xlContinuous
End With
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = True
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowNone,
LegendKey:=False
ActiveChart.PlotArea.Select
If line1 <> "" Then
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).XValues = wks.Range(rng_ff1)
ActiveChart.SeriesCollection(2).Values = wks.Range(rng_ff2)
ActiveChart.SeriesCollection(2).Name = "Actual Fx" & line1
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 4
.Weight = xlMedium
.LineStyle = xlContinuous
End With
End If
If line2 <> "" Then
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).XValues = wks.Range(rng_ff3)
ActiveChart.SeriesCollection(3).Values = wks.Range(rng_ff4)
ActiveChart.SeriesCollection(3).Name = "Actual Fx" & line2
ActiveChart.SeriesCollection(3).Select
With Selection.Border
.ColorIndex = 6
.Weight = xlMedium
.LineStyle = xlContinuous
End With
End If
If line3 <> "" Then
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(4).XValues = wks.Range(rng_ff5)
ActiveChart.SeriesCollection(4).Values = wks.Range(rng_ff6)
ActiveChart.SeriesCollection(4).Name = "Actual Fx" & line3
ActiveChart.SeriesCollection(4).Select
With Selection.Border
.ColorIndex = 7
.Weight = xlMedium
.LineStyle = xlContinuous
End With
End If
If line4 <> "" Then
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(5).XValues = wks.Range(rng_ff7)
ActiveChart.SeriesCollection(5).Values = wks.Range(rng_ff8)
ActiveChart.SeriesCollection(5).Name = "Actual Fx" & line4
ActiveChart.SeriesCollection(5).Select
With Selection.Border
.ColorIndex = 9
.Weight = xlMedium
.LineStyle = xlContinuous
End With
End If
If line5 <> "" Then
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(6).XValues = wks.Range(rng_ff9)
ActiveChart.SeriesCollection(6).Values = wks.Range(rng_ff10)
ActiveChart.SeriesCollection(6).Name = "Actual Fx" & line5
ActiveChart.SeriesCollection(6).Select
With Selection.Border
.ColorIndex = 10
.Weight = xlMedium
.LineStyle = xlContinuous
End With
End If
ActiveChart.Axes(xlCategory).Select
With Selection.Border
.ColorIndex = 57
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With Selection
.MajorTickMark = xlCross
.MinorTickMark = xlInside
.TickLabelPosition = xlNextToAxis
End With
With ActiveChart.Axes(xlCategory)
.MinimumScale = 0
.MaximumScale = 1
.MinorUnit = 0.02083333
.MajorUnit = 0.04166666
.Crosses = xlCustom
.CrossesAt = 0
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
Selection.TickLabels.NumberFormat = "hh:mm"
mytitle = InputBox("Print in Chart Title (With Date)")
ActiveChart.PlotArea.Select
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = mytitle
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Degrees"
End With
mychart = InputBox("Please type a name for Chart")
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=mychart
ActiveChart.ChartArea.Select
ActiveChart.Legend.Select
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 2
.Weight = xlThin
.LineStyle = xlDashDot
End With
Selection.Fill.TwoColorGradient Style:=msoGradientHorizontal,
Variant:=4
With Selection
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 2
.Fill.BackColor.SchemeColor = 15
End With
shCount = ThisWorkbook.Sheets.Count
Sheets(mychart).Move After:=Sheets(shCount)
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
I have made this macro to Plot a graph depeding upon the values in a
sheet specified by the user. I made this macro to run only if there are
values in A09, A10, A11, A12, A13. Can anyone pls suggest me where I am
doing wrong. There are 6 series to plot right now, which I will
increase to 10.
Even if ther is no value it must plot one series.
Also I am observing if there is only one sereis to plot it shows the
legend in bottom for those not present.
Pls help!!...Thanks in Advance
Sub make_graph_new()
'Macro by Kishore Maheshwari
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim workb As Workbook
Dim file_name, message_window, title_window, line_name As String
Dim lrow, lcol As Integer
Dim rng As Range
Dim rng_line As Variant
Dim shCount As Integer
Dim mystr As String
Dim mywks, wks As Worksheet
Dim dir As Integer
Dim mydrive, myfeatherfile, mycurrentmeter, myexcel As String
With Worksheets("instructions")
mydrive = .Cells(3, 4)
myfeatherfile = .Cells(4, 4)
mycurrentmeter = .Cells(5, 4)
myexcel = .Cells(6, 4)
' Directory Location Defined
ChDrive (mydrive)
'Set mywks = ActiveSheet
mystr = InputBox("Please type the name of Worksheet to Read the
Data")
'Application.StatusBar = ".....now processing... " & mystr
Set wks = ActiveWorkbook.Worksheets(mystr)
wks.Activate
' Calculate the Values for Graph (series 1)
iLastrowc = Cells(Rows.Count, "B").End(xlUp).Row
rng_graphb = Range(Cells(22, "B"), Cells(iLastrowc, "B")).Address
rng_graphg = Range(Cells(22, "G"), Cells(iLastrowc, "G")).Address
' select the range from feather location (values for series2-5)
If Range("A9") <> "" Then
iLastrowf1 = Cells(Rows.Count, "J").End(xlUp).Row
rng_ff1 = Range(Cells(22, "I"), Cells(iLastrowf1, "I")).Address
rng_ff2 = Range(Cells(22, "H"), Cells(iLastrowf1, "H")).Address
line1 = Cells(9, 1)
End If
If Range("A10") <> "" Then
iLastrowf2 = Cells(Rows.Count, "P").End(xlUp).Row
rng_ff3 = Range(Cells(22, "O"), Cells(iLastrowf2, "O")).Address
rng_ff4 = Range(Cells(22, "N"), Cells(iLastrowf2, "N")).Address
line2 = Cells(10, 1)
End If
If Range("A11") <> "" Then
iLastrowf3 = Cells(Rows.Count, "V").End(xlUp).Row
rng_ff5 = Range(Cells(22, "U"), Cells(iLastrowf3, "U")).Address
rng_ff6 = Range(Cells(22, "T"), Cells(iLastrowf3, "T")).Address
line3 = Cells(11, 1)
End If
If Range("A12") <> "" Then
iLastrowf4 = Cells(Rows.Count, "AB").End(xlUp).Row
rng_ff7 = Range(Cells(22, "AA"), Cells(iLastrowf4, "AA")).Address
rng_ff8 = Range(Cells(22, "Z"), Cells(iLastrowf4, "Z")).Address
line4 = Cells(12, 1)
End If
If Range("A13") <> "" Then
iLastrowf5 = Cells(Rows.Count, "AH").End(xlUp).Row
rng_ff9 = Range(Cells(22, "AG"), Cells(iLastrowf5, "AG")).Address
rng_ff10 = Range(Cells(22, "AF"), Cells(iLastrowf5, "AF")).Address
line5 = Cells(13, 1)
End If
Charts.Add
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
ActiveChart.SeriesCollection(1).XValues = wks.Range(rng_graphb)
ActiveChart.SeriesCollection(1).Values = wks.Range(rng_graphg)
ActiveChart.SeriesCollection(1).Name = "=""Current Meter Fx"""
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.ColorIndex = 5
.Weight = xlThick
.LineStyle = xlContinuous
End With
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = True
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowNone,
LegendKey:=False
ActiveChart.PlotArea.Select
If line1 <> "" Then
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).XValues = wks.Range(rng_ff1)
ActiveChart.SeriesCollection(2).Values = wks.Range(rng_ff2)
ActiveChart.SeriesCollection(2).Name = "Actual Fx" & line1
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 4
.Weight = xlMedium
.LineStyle = xlContinuous
End With
End If
If line2 <> "" Then
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).XValues = wks.Range(rng_ff3)
ActiveChart.SeriesCollection(3).Values = wks.Range(rng_ff4)
ActiveChart.SeriesCollection(3).Name = "Actual Fx" & line2
ActiveChart.SeriesCollection(3).Select
With Selection.Border
.ColorIndex = 6
.Weight = xlMedium
.LineStyle = xlContinuous
End With
End If
If line3 <> "" Then
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(4).XValues = wks.Range(rng_ff5)
ActiveChart.SeriesCollection(4).Values = wks.Range(rng_ff6)
ActiveChart.SeriesCollection(4).Name = "Actual Fx" & line3
ActiveChart.SeriesCollection(4).Select
With Selection.Border
.ColorIndex = 7
.Weight = xlMedium
.LineStyle = xlContinuous
End With
End If
If line4 <> "" Then
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(5).XValues = wks.Range(rng_ff7)
ActiveChart.SeriesCollection(5).Values = wks.Range(rng_ff8)
ActiveChart.SeriesCollection(5).Name = "Actual Fx" & line4
ActiveChart.SeriesCollection(5).Select
With Selection.Border
.ColorIndex = 9
.Weight = xlMedium
.LineStyle = xlContinuous
End With
End If
If line5 <> "" Then
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(6).XValues = wks.Range(rng_ff9)
ActiveChart.SeriesCollection(6).Values = wks.Range(rng_ff10)
ActiveChart.SeriesCollection(6).Name = "Actual Fx" & line5
ActiveChart.SeriesCollection(6).Select
With Selection.Border
.ColorIndex = 10
.Weight = xlMedium
.LineStyle = xlContinuous
End With
End If
ActiveChart.Axes(xlCategory).Select
With Selection.Border
.ColorIndex = 57
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With Selection
.MajorTickMark = xlCross
.MinorTickMark = xlInside
.TickLabelPosition = xlNextToAxis
End With
With ActiveChart.Axes(xlCategory)
.MinimumScale = 0
.MaximumScale = 1
.MinorUnit = 0.02083333
.MajorUnit = 0.04166666
.Crosses = xlCustom
.CrossesAt = 0
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
Selection.TickLabels.NumberFormat = "hh:mm"
mytitle = InputBox("Print in Chart Title (With Date)")
ActiveChart.PlotArea.Select
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = mytitle
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Degrees"
End With
mychart = InputBox("Please type a name for Chart")
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=mychart
ActiveChart.ChartArea.Select
ActiveChart.Legend.Select
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 2
.Weight = xlThin
.LineStyle = xlDashDot
End With
Selection.Fill.TwoColorGradient Style:=msoGradientHorizontal,
Variant:=4
With Selection
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 2
.Fill.BackColor.SchemeColor = 15
End With
shCount = ThisWorkbook.Sheets.Count
Sheets(mychart).Move After:=Sheets(shCount)
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub