I am in the middle of a problem: I need to use the combobox value as I key to search a data in other plan and when I find the same value, capture some some cells values in the same row and plot this. Could someone help me? I believe that my great problem is create some loop with charts, because I need to verify if this value is greater than 0.01 to capture it.
Attempts so far:
Private Sub ComboBox1_Click()
x = 751
y = 1
If Sheets("Data").Cells(x, 7).Value = Me.ComboBox1.Value Then
Sheets("Análises").ChartObjects("Chart 3").Activate
ChartObjects("Chart 3").SeriesCollection.NewSeries
ChartObjects("Chart 3").SeriesCollection(1).Name = Sheets("Data").Cells(x, 7).Value
If Sheets("Data").Cells(x, 7 + y).Value > 0.01 Then
ActiveChart.SeriesCollection(1).Values = "=Data!$L$752,Data!$N$752,Data!$R$752,Data!$T$752"
ActiveChart.SeriesCollection(1).XValues = "=Data!$H$10"
ActiveChart.SeriesCollection(1).XValues = "=Data!$H$10,Data!$J$10,Data!$L$10,Data!$N$10"
End If
Else
x = x + 1
End If
End Sub
I know this dont make much sense. I performed a macro to see how works with charts, but I realized this way I am trying to do, wont work. Somehow I need to pick up as value for my chart some cells (they are not sequencial) which will depend from ComboBox1 choose.
I already found how I capture the range with a loop, just need to put in chart now:
Sub ComboBox1_Change()
Dim rng As Range
Dim x As Integer
Dim y As Integer
y = 8
For x = 751 To 1000 Step 1
If Me.ComboBox1.Value = Worksheets("Data").Cells(x, y - 1).Text Then
Set rng = Worksheets("Data").Cells(x, y)
Do Until y > 36
y = y + 2
Set rng = Application.Union(rng, Worksheets("Data").Cells(x, y))
Loop
rng.Copy
End If
Next x
End Sub
I believe that my great problem is create some loop with charts
Use appropriate object variables:
Dim cObj as ChartObject
Dim cht as Chart
Then loop using For/Next:
For each cObj in ...
Set cht = cObj.Chart '## Chart is child of ChartObject
Next
Like this, maybe (I am not sure where you need to loop or what other logic you may require):
Dim cObj As ChartObject
Dim cht As Chart
Dim srs As Series
Dim x as Long
Dim y as Long
x = 751
y = 1
If Sheets("Data").Cells(x, 7).Value = Me.ComboBox1.Value Then
For each cht in Sheets("Análises").ChartObjects
Set srs = cht.SeriesCollection.NewSeries
srs.Name = Sheets("Data").Cells(x, 7).Value
If Sheets("Data").Cells(x, 7 + y).Value > 0.01 Then
'## NOTE: I suspect these ranges also need to change for each chart
' That is going to be better suited for a SEPARATE question.
srs.Values = "=Data!$L$752,Data!$N$752,Data!$R$752,Data!$T$752"
srs.XValues = "=Data!$H$10"
srs.XValues = "=Data!$H$10,Data!$J$10,Data!$L$10,Data!$N$10"
End If
Next
Else
x = x + 1
End If
Related
Right now I have the following code to display a line curve. The number of inputs can vary and I want the chart to clear and draw a new line curve every time the macro is run.
Sub addchart()
If ActiveSheet.ChartObjects.Count > 0 Then
ActiveSheet.ChartObjects.Delete
End If
Dim ws As Worksheet
Dim ch As chart
Dim ch1 As chart
Dim dt As Range
Dim i As Integer
i = Cells(Rows.Count, "I").End(xlUp).Row
Set ws = ActiveSheet
Set dt = Range(Cells(2, 10), Cells(i, 10))
Set ch = ws.Shapes.AddChart2(Width:=1300, Height:=300, Left:=Range("a13").Left, Top:=Range("a13").Top).chart
With ch
.SetSourceData Source:=dt
.ChartTitle.Text = "Deflection Curve"
.ChartType = xlLine
.SeriesCollection(1).Name = "Deflection"
End With
If Application.WorksheetFunction.Min(dt) > -50 Then
With ch.Axes(xlValue)
.MinimumScale = -50
.MaximumScale = 0
End With
End If
End Sub
The chart that is printed looks something like this
I'm trying to figure out how to add labels to arbitrary points to the chart. Two labels to be specific. One is at the minimum value. And one is the value at any arbitrary point on x-axis. Both x-values are known and will be taken as inputs from two cells on the sheet. Something like this.
The style of highlighting is unimportant. Thanks for the help!
P.S. - I'm new to VBA and I'm learning everything on the go. I look up what I need to do and then try and imitate whatever examples I see online. So it's possible the existing program I've written for the chart might have unnecessary steps or is inefficient in some way. I would appreciate it if someone had any tips to offer to improve it, even though it does the job. Thanks!
Try those for first steps making chart labels:
Dim chartname as string
chartname = "enter_a_name"
ActiveSheet.Shapes.AddChart2(227, xlLine).Name = chartname
With ActiveSheet.Shapes(chartname).Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Weight = 1.5
End With
Set my_chart = ActiveSheet.ChartObjects(chartname).Chart
'Delete all Autolabels
my_chart.SetElement (msoElementDataLabelNone)
'Enter format of axis (just if you want to)
'With my_chart.Axes(xlCategory) ' axis adjustment
'.CategoryType = xlCategoryScale ' not XlCategoryType.xlAutomaticScale | XlCategoryType.xlTimeScale
'.TickLabels.NumberFormat = "DD.MM.YYYY hh:mm"
'.TickLabels.Orientation = xlUpward
'End With
cols = Array("F", "L") ' columns containing labels
For j = 1 To my_chart.SeriesCollection.Count
Set sc = my_chart.SeriesCollection(j)
For i = 2 To sc.Points.Count
sc.Points(i).ApplyDataLabels
sc.Points(i).DataLabel.Text = Range(cols(j - 1) & i + x).Value ' x= starting row containing values /labels
Next i
Sub addchart()
If ActiveSheet.ChartObjects.Count > 0 Then
ActiveSheet.ChartObjects.Delete
End If
Dim ws As Worksheet
Dim ch As Chart
Dim dt As Range
Dim i As Integer
i = Cells(Rows.Count, "I").End(xlUp).Row
Set ws = ActiveSheet
Set dt = Range(Cells(2, 10), Cells(i, 11)) ' Added another column with the relevant values to highlight line chart
Set ch = ws.Shapes.AddChart2(Width:=1300, Height:=300, Left:=Range("a13").Left, Top:=Range("a13").Top).Chart
With ch
.SetSourceData Source:=dt
.ChartTitle.Text = "Deflection Curve"
.FullSeriesCollection(1).ChartType = xlLine
.SeriesCollection(1).Name = "Deflection"
.SeriesCollection(2).ChartType = xlColumnStacked 'the second column shows up as a bar chart along with the line chart
End With
If Application.WorksheetFunction.Min(Range(Cells(2, 10), Cells(i, 10))) > -30 Then
With ch.Axes(xlValue)
.MinimumScale = -30
.MaximumScale = 0
End With
End If
End Sub
This code copies the entire row to another when the word 'ordered' is in a certain column.
However, I need to adapt this code to not copy the entire row for another function but requires only copying columns A:J over into the next sheet but I'm having difficulty achieving this.
Sub MovingOrderedItems()
Dim xRg As Range
Dim xCell As Range
Dim X As Long
Dim Y As Long
Dim Z As Long
X = Worksheets("Engineer-Items to be ordered").UsedRange.Rows.Count
Y = Worksheets("Admin").UsedRange.Rows.Count
If Y = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Admin").UsedRange) = 0 Then Y = 0
End If
Set xRg = Worksheets("Engineer-Items to be ordered").Range("N3:N" & X)
On Error Resume Next
Application.ScreenUpdating = False
For Z = 1 To xRg.Count
If CStr(xRg(Z).Value) = "ordered" Then
xRg(Z).EntireRow.Copy Destination:=Worksheets("Admin").Range("A" & Y + 1)
xRg(Z).EntireRow.Delete
If CStr(xRg(Z).Value) = "ordered" Then
Z = Z - 1
End If
Y = Y + 1
End If
Next
Application.ScreenUpdating = True
End Sub
There's probably a more elegant way to do this, but you can replace
xRg(Z).EntireRow.Copy Destination:=Worksheets("Admin").Range("A" & Y + 1)
With
Range(xRg(Z).EntireRow.Cells(1, 1), xRg(Z).EntireRow.Cells(1, 10)).Copy Destination:=Worksheets("Admin").Range("A" & Y + 1)
I have a macro that does what I want but it runs on a set range of cells. I have been trying to make it run only on cells that are selected (highlighted) by the user. I've tried various combinations of defining the range using Dim Rng as Range and also Selection method. Me:No VBA experience to speak of, some python experience.
Working code (defined range)
Sub NoHalve()
'
' Macro to remove less-than sign and report only the LOR formatted grey and underlined .
' x = columns, y = rows
For x = 1 To 200
For y = 2 To 3000
If Left(Cells(y, x), 1) = "<" Then
Cells(y, x) = (Right(Cells(y, x), Len(Cells(y, x)) - 1))
Cells(y, x).Select
Selection.Font.ColorIndex = 16
Selection.Font.Underline = xlUnderlineStyleSingle
End If
Next y
Next x
End Sub
This is my attempt to make it run on user selected cells that gives me object required error for the r.Select line:
Sub NoHalve_selection()
Set Rng = Selection
For Each r In Rng
If Left(r, 1) = "<" Then
r = (Right(r, Len(r) - 1))
r.Select
Selection.Font.ColorIndex = 16
Selection.Font.Underline = xlUnderlineStyleSingle
End If
Next
End Sub
You're nearly there
Sub NoHalve_selection()
Dim r As Range, Rng As Range
Set Rng = Selection
For Each r In Rng.Cells ' .Cells is implied in For Each r in Rng
With r 'Using With block is more efficient as it does fewer lookups to Excel
If Left$(.Value, 1) = "<" Then ' .Value uses the With block (so is the same as r.Value). Value is the default property of a Range
.Value = Mid$(.Value, 2)
.Font.ColorIndex = 16
.Font.Underline = xlUnderlineStyleSingle
End If
End With
Next
End Sub
Original post for comparison
Sub NoHalve_selection()
Dim r As Range, Rng As Range
Set Rng = Selection
For Each r In Rng
If Left(r, 1) = "<" Then
r = (Right(r, Len(r) - 1))
r.Font.ColorIndex = 16
r.Font.Underline = xlUnderlineStyleSingle
End If
Next
End Sub
This should be relatively easy by replacing the hard coded numbers with Selection.Columns.Count and Selection.Rows.Count.
Sub NoHalve()
'
' Macro to remove less-than sign and report only the LOR formatted grey and underlined .
' x = columns, y = rows
For x = 1 To Selection.Columns.Count
For y = 2 To Selection.Rows.Count
If Left(Cells(y, x), 1) = "<" Then
Cells(y, x) = (Right(Cells(y, x), Len(Cells(y, x)) - 1))
Cells(y, x).Font.ColorIndex = 16
Cells(y, x).Font.Underline = xlUnderlineStyleSingle
End If
Next y
Next x
End Sub
If you are making a simple text substitution (removing a sign), as long as that sign is left most then I'd also suggest maybe using something that doesn't rely so heavily on the position of the characters in a string. So something like replace:
Cells(y, x) = replace(Cells(y, x),"<","",,1)
Also I don't believe the line Cells(y, x).Select is required and may change the active selection unnecessarily.
I have created a chart using vba excel, then accidentally populate a graph that show the user and the counts which I prefer. But stupid of me I forgot to save, due to testing. Now I cant get the logic how to set it again. please help, thanks
Sample Data
Operator Counts Team
OPSHAF 123 A
OPSAJC 1245 B
OPSZAL 23 A
OPSJGY 162 C
OPSOSM 54 D
Sub CreateChart()
Dim rEmailRng As Range
Dim oEmailCht As Object
Dim cEmailCht As Chart
Dim coEmailCht As ChartObject
Dim iEmailRow As Integer
Dim sEmailSeries As Series
Dim scEmailSerCol As SeriesCollection
On Error Resume Next
Set wb = ThisWorkbook
Set wbsh2 = wb.Worksheets("Email")
Set coEmailCht = wbsh2.ChartObjects.Add(Range("E5").Left, Range("E5").Top, 500, 300)
coEmailCht = "Email Requests Processed" '& year
Set cEmailCht = coEmailCht.Chart
With cEmailCht
.HasLegend = False
.HasTitle = True
.Axes(xlValue).MinimumScale = 50
.Axes(xlValue).MaximumScale = 1500
.ChartTitle.Text = "Email Processed by Operator"
Set scEmailSerCol = .SeriesCollection
Set sEmailSeries = scEmailSerCol.NewSeries
With sEmailSeries
.Name = Range("A1").Offset(0, 1).Value
.XValues = Range(Range("A1").Offset(1, 0), Range("A1").End(xlDown))
.Values = Range(Range("A1").Offset(1, 1), Range("A1").Offset(1, 1).End(xlDown))
.ChartType = xl3DColumnClustered
End With
End With
Welcome To SO. If Your Objective is that axis label contain Count along with Operator then simply try
With sEmailSeries
'
.XValues = Range("A2:B" & Range("B2").End(xlDown).Row)
if you want team name also then
.XValues = Range("A2:C" & Range("C2").End(xlDown).Row)
I am new to VBA and to this forum. I have a table with dates as the first column (x column) and 12 columns of data pertaining to the data (y values). I am trying to plot the data in a simple xlLine chart. Only few selected columns are to be plotted for y values. The columns are selected using a combo box at the top of the column. The number of rows are variable.
I am using this code but this is not working. Can someone kindly let me know what is wrong and fix it? Appreciate any help. Thanks in advance.
Sub drawchart1()
'
' drawchart1 Macro
'
'
Dim i As Integer
Dim j As Integer
Dim n As Integer
' finding the number of rows
j = Range("Charts!A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row
' selecting some range and adding a chart which is then modified.(not sure this is the correct method.)
Range("A10:C15").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
i = 2
n = 2
' Cells (9,1) contains the value "Date". Defining the X Axis values
ActiveChart.SeriesCollection(1).Name = Sheets("Charts").Cells(9, 1).Value
ActiveChart.SeriesCollection(1).XValues = "=Charts!R10C1:R" & j & "C1"
Do While i < 14
' Cells(8,i) contain the results of combo box - true or false.
' Cells(9,i) contain the names of the series
If Cells(8, i).Value = True Then
ActiveChart.SeriesCollection(n).Name = Sheets("Charts").Cells(9, i).Value
ActiveChart.SeriesCollection(n).Values = "=Charts!R10C" & i & ":R" & j & "C" & i
n = n + 1
i = i + 1
Else
i = i + 1
End If
Loop
End Sub
Hi Again,
Since my columns would not exceed 14 (i.e. not large), I used the following "brute force" technique and it worked fine. I would still love to learn how to do it without using the "brute force" technique. Thanks in advance.
Sub drawchart()
Dim j As Integer
Dim Chartstring As String
j = Range("Charts!A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row
Chartstring = "A9:A" & j
If Cells(8, 2).Value = True Then
Chartstring = Chartstring & ", B9:B" & j
Else
Chartstring = Chartstring
End If
If Cells(8, 3).Value = True Then
Chartstring = Chartstring & ", C9:C" & j
Else
Chartstring = Chartstring
End If
' And similarly added code for each of the 14 columns
' And finally fed the chartstring into the "Source"
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Range(Chartstring)
End Sub
Probably you're not watching any more. Here's an alternative approach.
Sub DrawChart1()
Dim i As Long
Dim j As Long
Dim ws As Worksheet
Dim rCht As Range, rYVals As Range
Dim cht As Chart
' finding the number of rows
Set ws = Worksheets("Charts")
j = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' start with X values (row 10 to j), include header row (row 9)
Set rCht = ws.Range(ws.Cells(9, 1), ws.Cells(j, 1))
' add column of Y values if row 8 of column is TRUE
For i = 2 To 14
If ws.Cells(8, i).Value Then
Set rYVals = ws.Range(ws.Cells(9, i), ws.Cells(j, i))
Set rCht = Union(rCht, rYVals)
End If
Next
' if we've had any Y values, insert chart, using range we've built up
If Not rYVals Is Nothing Then
Set cht = ws.Shapes.AddChart(xlLine).Chart
cht.SetSourceData Source:=rCht, PlotBy:=xlColumns
End If
End Sub