A piece of my code goes through a range of cells and if some cell satisfies certain criteria - inserts the shape in this cell. It works, but I would like to find out an alternative approach avoiding select.
'above - code to find satisfying cell
ActWS.Activate 'Activate Sheet
ActWS.Cells(rActPlan - 1, vReturnColumn).Select 'Select satisfying cell
ActiveSheet.Shapes.AddShape(msoShapeOval, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height).Select
Selection.ShapeRange.Fill.Visible = msoFalse
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 255, 0)
.Weight = 2.25
End With
This code removes all .Select and ActiveCell references:
With ActWs
Dim rng as Range
Set rng = .Cells(rActPlan - 1, vReturnColumn)
Dim shp as Shape
Set shp = .Shapes.AddShape(msoShapeOval, rng.Left, rng.Top, rng.Width, rng.Height)
With shp.ShapeRange
.Fill.Visible = msoFalse
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 255, 0)
.Transparency = 0
.Weight = 2.25
End With
End With
End With
AddShape() returns the just-added shape object, so you should be able to use something like the code below - then refer to shp instead of Selection
Dim shp as Shape
Set shp = ActiveSheet.Shapes.AddShape(msoShapeOval, ActiveCell.Left, _
ActiveCell.Top, ActiveCell.Width, ActiveCell.Height)
Related
I am using a macro to insert a chart into a spreadsheet:
Option Explicit
Sub Macro1()
Dim overskrifter As Range
Dim i As Long
Dim høgde As Long, breidde As Long
Call fjernkurver
i = 1
høgde = 240: breidde = 350
Set overskrifter = Oppsummering.Range("C5:L5")
With Kurver.Shapes.AddChart2(201, xlColumnClustered)
.Name = "Graf_" & i
With .Chart.SeriesCollection.NewSeries
.XValues = overskrifter
.Values = overskrifter.Offset(i, 0)
.Name = Oppsummering.Range("B5").Offset(i, 0)
' "Olive"
.Points(1).Format.Fill.ForeColor.RGB = RGB(128, 128, 0)
' "Dark khaki"
.Points(8).Format.Fill.ForeColor.RGB = RGB(189, 183, 107)
' Green (Atlantis)
.Points(9).Format.Fill.ForeColor.RGB = RGB(146, 208, 80)
With .Format.Line
.Visible = msoTrue
.Weight = 0.5
'.ForeColor.RGB = RGB(0, 0, 205)
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
End With
.Height = høgde
.Width = breidde
.Top = 5 + ((i - 1) \ 3) * (5 + høgde)
.Left = 5 + ((i - 1) Mod 3) * (5 + breidde)
.Chart.HasTitle = True
.Chart.ChartGroups(1).GapWidth = 150
.Chart.ChartGroups(1).Overlap = 0
End With
End Sub
Sub fjernkurver()
Dim co As ChartObject
For Each co In Kurver.ChartObjects
co.Delete
Next co
End Sub
For the most part it works fine, but I am having some issues with this part of the code:
With .Format.Line
.Visible = msoTrue
.Weight = 0.5
'.ForeColor.RGB = RGB(0, 0, 205)
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
It is supposed to add a border around all the bars in the graph, red with RGB(255,0,0), blue with RGB(0,0,255).
However, as far as I can tell, no border is added to any of the bars. Can someone please point out where I am going wrong here?
The chart ends up looking like this:
It appears that the .Format.Line property of a series applies to something else than the border of a bar chart - a guess would be that it is the line connecting the datapoints of e.g. a line or scatter chart.
To actually outline the bars, I replaced the offending code;
With .Format.Line
.Visible = msoTrue
.Weight = 0.5
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
with
.Border.LineStyle = xlContinuous
.Border.Color = 9851952
.Format.Line.Weight = 0.5
Please don't ask me why .Format.Line.Weight still applies to the border, at least I got it working. Big props to the people who'd written the thread where I found the answer on Ozgrid forums.
Could anyone tell me what is wrong with the following code?
It is working most of the time, however sometimes it fails to apply proper colour. For example if the % change from 97% to 100% in cell D112, it will not apply the green colour, but in some cases it will.
Basically based on a % value of a cell D112, I want to apply different colour to the bar chart.
If Range("D112") < 0.96 Then
ActiveSheet.ChartObjects("Chart 18").Activate
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.FullSeriesCollection(1).Points(3).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(204, 0, 51)
.Transparency = 0
.Solid
End With
Range("P8").Interior.Color = RGB(204, 0, 51)
ElseIf Range("D112") >= 0.96 And Range("D112") <= 0.98 Then
ActiveSheet.ChartObjects("Chart 18").Activate
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.FullSeriesCollection(1).Points(3).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 102, 0)
.Transparency = 0
.Solid
End With
Range("P8").Interior.Color = RGB(255, 102, 0)
Else
ActiveSheet.ChartObjects("Chart 18").Activate
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.FullSeriesCollection(1).Points(3).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 153, 102)
.Transparency = 0
.Solid
End With
Range("P8").Interior.Color = RGB(0, 153, 102)
End If
First: you can replace you multiple Ifs and Else with Select Case, it will clean and shorten you code by a lot.
Second: there's no need to select the chart and the point in each of these conditions, you are repeating the same procedures for all scenarios, you can do that before the Ifs section (or Select Case).
Third: it's better to avoid using Select, Activate and Selection, instead fully qualify all your Chart, Series and Point objects.
More explanation in the code below;
Code
Option Explicit
Sub ColorGraphs()
Dim ChrtObj As ChartObject
Dim Ser As Series
Dim SerPoint As Point
' set the ChartObject
Set ChrtObj = ActiveSheet.ChartObjects("Chart 18")
' set the Series
Set Ser = ChrtObj.Chart.SeriesCollection(1)
' set the series point
Set SerPoint = Ser.Points(3)
' these setting are the same for all your scenarios
With SerPoint.Format.Fill
.Visible = msoTrue
.Transparency = 0
.Solid
End With
Select Case Range("D112").Value
Case Is < 0.96
SerPoint.Format.Fill.ForeColor.RGB = RGB(204, 0, 51)
Range("P8").Interior.Color = RGB(204, 0, 51)
Case 0.96 To 0.98
SerPoint.Format.Fill.ForeColor.RGB = RGB(255, 102, 0)
Range("P8").Interior.Color = RGB(255, 102, 0)
Case Else ' larger than 0.98
SerPoint.Format.Fill.ForeColor.RGB = RGB(0, 153, 102)
Range("P8").Interior.Color = RGB(0, 153, 102)
End Select
End Sub
I have two columns were is information that I use in chart and it is changing according to what time range I choose. The main problem is that the columns length can be different, it can be 5 rows and when I choose another period of time it can be 7 rows or less then 5. The data in chart is refreshing, but the number of columns not, e.g. I have data like this:
Tom 20
Susan 30
John 15
So the chart would have three columns and their color is different according to the value in the first column, but when I choose another period of time data changes to:
Peter 40
Patrick 70
Joe 36
Megan 57
Susan 74
Now the chart will contain three columns with only the first three names: Peter, Patrick, Joe and the color of columns will be the same as in the first chart.
I hope it is easy to understand my problem, the main thing is that the visualization of the chart doesn't change as it's supposed to. I add a part of my code:
Sub Macro1()
Dim MyRangex As Range
Dim LastRow As Long
Dim ChartRange1 As Range
LastRow = Worksheets("Calculate").Cells(Rows.Count, "E").End(xlUp).row
Set MyRangex = Worksheets("Calculate").Range("E2:E" & LastRow)
Set ChartRange1 = Sheets("Calculate").Range("G2:G" & LastRow)
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).XValues = MyRangex
ActiveChart.SeriesCollection(1).Values = ChartRange1
For i = 1 To Worksheets("Calculate").Cells(9, 10).value
ActiveChart.SeriesCollection(1).Points(i).Select
Select Case Worksheets("Calculate").Cells(i + 1, 5).value
Case Is = "Tom"
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
.Solid
End With
Case Is = "Susan"
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
.Solid
End With
Case Is = "Joe"
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 0)
.Transparency = 0
.Solid
End With
Case Is = "John"
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(191, 191, 191)
.Transparency = 0
.Solid
End With
End Select
Next i
End Sub
You should employ a Worksheet_Change event. It must reside in the worksheet module.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Me.Range("C2"), Target) Is Nothing Then
MsgBox "data in C2 was changed"
End If
End Sub
The MsgBox in this example appears only when data in the cell C2 is changed. Depending on how you change your new period, this part should be changed.
No matter if you update your period manually or automatically, I am sure the code below will work for you. (Unless there are formulas under these names.)
Requirements for usage:
1. Place this code inside your worksheet module (not a regular module which appears after you record a macro).
2. Rename your chart to "MyChartName" OR replace this name in the code with your actual chart name.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRangex As Range
Dim LastRow As Long
Dim ChartRange1 As Range
Dim i As Long
Dim mySeries As Series
If Not Intersect(Me.Range("E2:E100"), Target) Is Nothing Then
LastRow = Worksheets("Calculate").Cells(Rows.Count, "E").End(xlUp).Row
Set MyRangex = Worksheets("Calculate").Range("E2:E" & LastRow)
Set ChartRange1 = Sheets("Calculate").Range("G2:G" & LastRow)
Set mySeries = ActiveSheet.ChartObjects("MyChartName").Chart.SeriesCollection(1)
mySeries.XValues = MyRangex
mySeries.Values = ChartRange1
For i = 1 To Worksheets("Calculate").Cells(9, 10).Value
With mySeries.Points(i).Format.Fill
Select Case Worksheets("Calculate").Cells(i + 1, 5).Value
Case Is = "Tom"
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
.Solid
Case Is = "Susan"
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
.Solid
Case Is = "Joe"
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 0)
.Transparency = 0
.Solid
Case Is = "John"
.Visible = msoTrue
.ForeColor.RGB = RGB(191, 191, 191)
.Transparency = 0
.Solid
End Select
End With
Next
End If
End Sub
I need help coding this VBA for a work project. I have a map with all the shapes (States) named and I have column U2:U52 with the the State abbreviations and column V2:V52 with the data. I need a macro to run through an "If Then" statement to change the colors and Loop through each State (line of data) based on the data entered.
Sub map1()
Dim Rng As Range
Dim ShapeName As String
Dim SHP As Shape
ShapeName = "AL"
Set Rng = ThisWorkbook.Worksheets("Sheet1").Range("V2")
Set SHP = Rng.Parent.Shapes(ShapeName)
If Rng.Value <= 1.6 Then
SHP.Fill.ForeColor.RGB = RGB(255, 0, 0) 'Red
End If
If Rng.Value > 1.6 And Rng.Value < 2.4 Then
SHP.Fill.ForeColor.RGB = RGB(0, 255, 0) 'Green
End If
If Rng.Value >= 2.4 Then
SHP.Fill.ForeColor.RGB = RGB(255, 255, 0) 'yellow
End If
End Sub
The way its written is for just one shape, how do I change it to run all states without coding it 52 times?
Here is a simple loop that should work.
Sub map1()
Dim Rng As Range
Dim ShapeName As String
Dim SHP As Shape
For i = 2 to 52
ShapeName = ThisWorkbook.Worksheets("Sheet1").Range("U" & i).Value
Set Rng = ThisWorkbook.Worksheets("Sheet1").Range("V" & i)
Set SHP = Rng.Parent.Shapes(ShapeName)
If Rng.Value <= 1.6 Then
SHP.Fill.ForeColor.RGB = RGB(255, 0, 0) 'Red
ElseIf Rng.Value > 1.6 And Rng.Value < 2.4 Then
SHP.Fill.ForeColor.RGB = RGB(0, 255, 0) 'Green
ElseIf Rng.Value >= 2.4 Then
SHP.Fill.ForeColor.RGB = RGB(255, 255, 0) 'yellow
End If
Next i
End Sub
I have been working on a macro for the past week to automatically create charts in excel. I have gotten pretty far along with it (thanks in large part to help from this website and its users), but I am stuck on a seemingly insignificant step. For some reason my line with markers graph shows up with discolorations in it. What I mean by this is that the middle fill of the marker is the standard blue that excel defaults to. I think the issue lies with the [ .Visible = msoTrue] line but no matter how I manipulate the code, I cannot make my markers one solid color.
The code is below
Sub DM1R_Graph()
Dim ws As Worksheet
For Each ws In Sheets
ws.Activate
If ws.Name <> "WSNs" Then
Dim sht As Worksheet
Dim xVals As Range, yVals As Range
Dim co As Shape, cht As Chart, s As Series
Set sht = ActiveSheet
Set co = sht.Shapes.AddChart()
Set cht = co.Chart
'remove any existing series
Do While cht.SeriesCollection.Count > 0
cht.SeriesCollection(1).Delete
Loop
cht.ChartType = xlLineMarkers
'get the extent of the XValues...
'below is the first Y axis entry (Oil)
'(change the 2nd offset number to get what you want)
Set xVals = sht.Range(sht.Range("B2"), sht.Cells(Rows.Count, "B").End(xlUp))
Set yVals = xVals.Offset(0, 2)
Set s = cht.SeriesCollection.NewSeries
s.XValues = xVals
s.Values = yVals
With s.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 80)
.Transparency = 0
.Solid
End With
With s.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 80)
.Transparency = 0
End With
'below is the second y axis entry (Gas)
Set xVals = sht.Range(sht.Range("B2"), sht.Cells(Rows.Count, "B").End(xlUp))
Set yVals = xVals.Offset(0, 4)
Set s = cht.SeriesCollection.NewSeries
s.XValues = xVals
s.Values = yVals
With s.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
.Solid
End With
With s.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
'below is the third y axis entry (water)
Set xVals = sht.Range(sht.Range("B2"), sht.Cells(Rows.Count, "B").End(xlUp))
Set yVals = xVals.Offset(0, 5)
Set s = cht.SeriesCollection.NewSeries
s.XValues = xVals
s.Values = yVals
With s.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
.Solid
End With
With s.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
End With
'end Y axis entries
cht.HasLegend = True
'below applies the legend names to be whatever are in parenthesis'
cht.Legend.Select
ActiveChart.SeriesCollection(1).Name = "Oil (BO)"
ActiveChart.SeriesCollection(2).Name = "Gas (MCF)"
ActiveChart.SeriesCollection(3).Name = "Water (BW)"
'below applies the data labels
cht.SeriesCollection(1).Select
cht.SeriesCollection(1).ApplyDataLabels
cht.SeriesCollection(2).Select
cht.SeriesCollection(2).ApplyDataLabels
cht.SeriesCollection(3).Select
cht.SeriesCollection(3).ApplyDataLabels
'below orients the datalabels to either above,below,right,or left
cht.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.Position = xlLabelPositionRight
cht.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).DataLabels.Select
Selection.Position = xlLabelPositionAbove
cht.SeriesCollection(3).Select
ActiveChart.SeriesCollection(3).DataLabels.Select
Selection.Position = xlLabelPositionLeft
'below moves the chart
Dim iChart As Long
Dim lTop As Double
lTop = ActiveSheet.Range("Q10").Top
For iChart = 1 To ActiveSheet.ChartObjects.Count
ActiveSheet.ChartObjects(iChart).Top = lTop
ActiveSheet.ChartObjects(iChart).Left = ActiveSheet.Range("Q1").Left
lTop = lTop + ActiveSheet.ChartObjects(iChart).Height + ActiveSheet.Range("5:7").Height
Next
'below deals with the chart title
cht.SetElement (msoElementChartTitleAboveChart)
With cht.ChartTitle
.Text = sht.Name & Chr(10) & "Oil,Gas, and Water Production Through Well Life "
.Characters.Font.Size = 12
End With
'below adds a filter to one column. You cannot have more than 1 filter per sheet.
Columns("L:L").Select
Selection.AutoFilter
End If
Next ws
End Sub
Below is a picture showing what I mean. You can see it obviously in the red series, but it also appears in the green and blue series as well.
I believe you need to set the MarkerBackgroundColor on the series.
s.MarkerBackgroundColor = RGB(255, 0, 0)