I want to use a for loop to switch between X and Y ranges for all Series in an active Scatter chart.
The exiting Series have value like this:
=SERIES("Name",Sheet1!$B$3:$B$23,Sheet1!$A$3:$A$23)
I want to change to:
=SERIES("Name",Sheet1!$A$3:$A$23,Sheet1!$B$3:$B$23)
switching between X and Y ranges.
Please help to complete the function:
Sub SwitchXY()
For i = 1 To ActiveChart.SeriesCollection.Count
'Please help here!
Next
End Sub
I am not sure why do you use a for next in this case, but if you simply want to change the formula of the chart. I believe you can work by this way:
Sub SwitchXY()
Dim formulaArray() As String
formulaArray = Split(ActiveChart.FullSeriesCollection(1).Formula, ",")
ActiveChart.FullSeriesCollection(1).Formula = formulaArray(0) & "," & _
formulaArray(2) & "," & _
formulaArray(1) & "," & _
formulaArray(3)
End Sub
Related
this line is giving me an error,please help me to troubleshoot
ActiveCell.Formula = "=STDEVA(range(" & """" & area & """" & ")"
here area is a string variable which is having the value it supposed to have just fine
So the main issue is syntax and more specifically the quotation marks I guess,any help is appreciated,even though I can use stdev I still like to use stdeva in my macro although the difference is very subtle.
This assumes that area is a String`:
Sub gahgsd()
Dim area As String
area = "A1:A4"
ActiveCell.Formula = "=STDEVA(" & Range(area).Address & ")"
End Sub
or:
Sub gahgsd()
Dim area As String
area = "A1:A4"
ActiveCell.Formula = "=STDEVA(" & area & ")"
End Sub
I made this code a year or so ago and it's been working fine. Recently, however, it broke. I am assuming there was a Windows update that changed the way Excel's macros worked with charts. The pertinent sections of my code perform the following:
Create an XY Scatter chart on a "prep" worksheet
Create a trendline for each data series on the XY Scatter
Parse each trendline text for slope and R^2, coping them as text onto another "summary" worksheet
What I've found is that Step 1 and 2 work fine, but when I try to parse the trendline text (expecting something like y = 0.0289x + 143), I get an empty string (see the commented out MsgBox, below). What's weirder is that when the Macro finishes (or fails) the chart updates and the text shows normally.
' Create the graph for the linear part of the data set
Worksheets(PrepSheetName).Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterSmooth
ActiveChart.SetSourceData Source:=Range("$B$19:$G$38")
' ActiveChart.Name = "Linear"
'MsgBox "Past linear creation"
' Add each data set to the chart individually
ActiveChart.PlotArea.Select
For i = 1 To 5
' Construct a string like ='Data'!$C$19:$C$38
YValues = "='" & PrepSheetName & "'!$" & DSMeasCol(i) & "$"
YValues = YValues & CStr(PrepDataStart) & ":$" & DSMeasCol(i) & "$"
YValues = YValues & CStr(PrepDataEnd(i))
' Construct a string like ='Data'!$C$19:$C$38
XValues = "='" & PrepSheetName & "'!$" & DSCmdCol(i) & "$"
XValues = XValues & CStr(PrepDataStart) & ":$" & DSCmdCol(i) & "$"
XValues = XValues & CStr(PrepDataEnd(i))
' Give the chart values
ActiveChart.SeriesCollection(i).Values = YValues
ActiveChart.SeriesCollection(i).XValues = XValues
' Create a trendline for the chart
Dim TL As Trendline
Set TL = ActiveChart.SeriesCollection(i).Trendlines.Add(Type:=xlLinear, Forward:=0, _
Backward:=0, DisplayEquation:=1, DisplayRSquared:=0, _
Name:="LC" & CStr(i) & " Trend")
TL.DisplayEquation = True
TL.DisplayRSquared = False
' Exract the trendline formula
Dim Eqn As String
TL.Select
'MsgBox "Trendline Text: " + TL.DataLabel.Text
Eqn = Split(TL.DataLabel.Text, "=")(1)
' ... and place it on the coversheet ...
CoverSheet.Cells(CSResults(i), CSFitSlope).Value = Split(Eqn, "x")(0)
CoverSheet.Cells(CSResults(i), CSFitOffset).Value = Split(Eqn, "x")(1)
'Find the RSquared of the Trendline
TL.DisplayEquation = False
TL.DisplayRSquared = True
TL.Select
Eqn = TL.DataLabel.Text
Eqn = Split(TL.DataLabel.Text, "=")(1)
' ... and place it on the coversheet ...
'CoverSheet.Cells(CSResults(i), CSFitCorr).Value = Eqn
Next i
If I try to run diagnostic code to parse the tredline datalabel text after running the macro the first time, it sees the text. When running the diagnostic code, though, I can't change the type of trendline data that is shown. I would expect, for example, that if I run:
TL.DisplayEquation = True
TL.DisplayRSquared = False
MsgBox "Should show Equation."
TL.DisplayEquation = False
TL.DisplayRSquared = True
MsgBox "Should show R^2."
... that I should see the trendline data label only show the equation when the first message box appears and the second message box should freeze the screen such that only the the R^2 is showing. When I run code like this, though, I find that my assumption is not true: The datalabel stays frozen until the macro completes, even with ScreenUpdating = True It seems like my charts aren't updating when the macro runs, but only updates at the end.
I've tried putting DoEvents and Application.Recalculate after creating the trendline, but it just causes my Excel to crash. Adding Application.ScreenUpdating = True or False doesn't seem to help, either...
Any ideas? I'm at a total loss...
Please let me know if I haven't provided enough information or anything is unclear.
Thanks!
I ended up using chillin's suggestion and used LinEst. It seems this is a bug in how Excel handles Chart DataLabels during Macro execution, as per this thread. To summarize, my code is almost the same as above, but with the following change using LinEst instead of parsing the Trenline's DataLabel:
' Create a trendline for the chart
Dim TL As Trendline
Set TL = ActiveChart.SeriesCollection(i).Trendlines.Add(Type:=xlLinear, Forward:=0, _
Backward:=0, DisplayEquation:=1, DisplayRSquared:=0, _
Name:="LC" & CStr(i) & " Trend")
' Generate the trendline constants and place them on the summary sheet
CoverSheet.Cells(CSResults(i), CSFitSlope).Value = "=INDEX(LINEST(" & YValues & "," & XValues & ",TRUE, TRUE), 1)"
CoverSheet.Cells(CSResults(i), CSFitOffset).Value = "=INDEX(LINEST(" & YValues & "," & XValues & ",TRUE, TRUE), 1,2)"
CoverSheet.Cells(CSResults(i), CSFitCorr).Value = "=INDEX(LINEST(" & YValues & "," & XValues & ",TRUE, TRUE), 3)"
I´m developing an Excel Makro right now.
Wanted to know, how I can repeat some lines of code using different data, without copy and paste.
Looking forward for your answers : )
This is my current code:
Sub deleteredundant()
Windows("Test1.xlsm").Activate
If Range("A6") = Range("A7") And Range("B6") = Range("B7") Then
Range("A7:B7").Select
Selection.ClearContents
End If
End Sub
It sounds like #BruceWayne has pointed in you in the right direction for what you need - removing duplicates.
As #Apurv Pawar shows you can use a loop, but he's selecting cells (if any code says select or activate a cell just don't.... you can reference a cell without selecting).
Another way is to have a procedure to remove the cells, and another procedure to tell it which workbook, worksheet and cell to look at.
Sub DeleteRedundant(CheckRange As Range)
If CheckRange = CheckRange.Offset(1) And CheckRange.Offset(, 1) = CheckRange.Offset(1, 1) Then
CheckRange.Offset(1).Resize(, 2).ClearContents
End If
End Sub
The code above will accept a range that is passed to it.
It will check if the passed cell is equal to the cell below itself:
CheckRange = CheckRange.Offset(1)
It will then check if the cell to the right of the passed cell is equal to the value below that:
CheckRange.Offset(, 1) = CheckRange.Offset(1, 1)
If the values match it will look at the cell below the passed cell, resize that to two cells wide and clear the contents of those two cells:
CheckRange.Offset(1).Resize(, 2).ClearContents
With this procedure in place we can pass it various range references to operate on:
Sub Test()
DeleteRedundant Workbooks("Excel Worksheet1.xlsx").Worksheets("Sheet1").Range("A6")
DeleteRedundant Workbooks("Excel Worksheet2.xlsx").Worksheets("Sheet2").Range("D5")
'Pass every other cell to the procedure in a loop.
'So will pass A2, A4, A6 - Cells(2,1), Cells(4,1) and Cells(6,1)
Dim x As Long
For x = 2 To 20 Step 2
DeleteRedundant Workbooks("Excel Worksheet1.xlsx").Worksheets("Sheet1").Cells(x, 1)
Next x
End Sub
But, as #BruceWayne says - you probably just need the Delete Duplicates button on the data ribbon.
try the below.
Sub deleteredundant()
Windows("Test1.xlsm").Activate
x = 1
Do While Range("a" & x).Formula <> ""
If Range("A" & x) = Range("A" & (x + 1)) And Range("B6" & x) = Range("B7" & (x + 1)) Then
Rows(x & ":" & x).Select
With Selection
.Delete EntireRow
End With
End If
x = x + 1
Loop
End Sub
I have an Excel bar chart, with horizontal axis labels. Some of the title labels are blank as shown in the graph. How I can I deselect these labels form the the axis labels so they are not shown in the graph through vba code.
Thank you and your help is much appreciated...
I just avoided the whole deselecting thing by building the Chart CollectionSeries XValues and Values string based on the required specific cells. Avoiding the blank empty cell.
Dim chartPhaseXValues As String
Dim chartDurationValues As String
'For Loop Here
chartPhaseXValues = chartPhaseXValues & oExcel.ActiveSheet.Name & "!" & _
oExcel.Range("A1").Offset(rowCount, 1).Address & ","
hartDurationValues = chartDurationValues & oExcel.ActiveSheet.Name & "!" & _
oExcel.Range("A1").Offset(rowCount, 4).Address & ","
'End For Loop
' Remove the trailing , at the end of each string
chartPhaseXValues = Left(chartPhaseXValues, Len(chartPhaseXValues) - 1)
chartDurationValues = Left(chartDurationValues, Len(chartDurationValues) - 1)
' Add the Series to the graph
oExcel.ActiveChart.SeriesCollection.NewSeries
oExcel.ActiveChart.FullSeriesCollection(1).Name = "=""StartDate"""
oExcel.ActiveChart.FullSeriesCollection(1).Values = "=" & chartDurationValues
oExcel.ActiveChart.FullSeriesCollection(1).XValues = "=" & chartPhaseXValues
I am fairly new to Excel Macros and I am looking for a way to loop through the row headings and columns headings and combine them into one cell for each row and column heading until I have combined all of them.
An example of the First Column cell would be "Your Organizations Title"
An Example of the First Row Cell Would be "22. Cheif Investment Officer"
An example of the first combined cell that I want on a new sheet would be this: "22. Chief Investment Officer (Your Organization's Title)
I then want the combined cells on the new sheet to offset one column to the right until it has iterated through all of the rows and columns.
I have just joined the forum and it will not let me post images or I would have. Perhaps this gives a better idea, here is my code now:
Sub Fill()
' Select cell A2, *first line of data*.
Set title = Sheets("Compensation, 3").Range("B6:B500")
Set descr = Sheets("Compensation, 3").Range("C5:AAA5")
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(title.Value)
Do Until IsEmpty(descr.Value)
ActiveCell.Offset(0, 1).Formula = _
"=title.value & "" ("" & descr.value & "")"""
Set descr = descr.Offset(0, 1)
Loop
Set title = title.Offset(1, 0)
Loop
End Sub
When I run it goes puts this into the active cell:
=title.value & " (" & descr.value & ")"
It does not recognize the variables and come up with the NAME error. It also goes into an infinite loop with no output besides the one cell.
Edit:
I cannot answer my own question because I am new to the forum, but using a combination of your answers I have solved the problem!
Here is the finished code:
Sub Fill()
' Select cell A2, *first line of data*.
Set title = Sheets("Compensation, 3").Range("B6")
Set descr = Sheets("Compensation, 3").Range("C5")
offsetCtr = 0
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(title.Value)
Do Until IsEmpty(descr.Value)
ActiveCell.Offset(0, offsetCtr).Formula = title.Value & " (" & descr.Value & ")"
offsetCtr = offsetCtr + 1
Set descr = descr.Offset(0, 1)
Loop
Set descr = Sheets("Compensation, 3").Range("C5")
Set title = title.Offset(1, 0)
Loop
End Sub
Thank you so much!
Option Explicit
Sub GenerateAndPasteFormulaForTitleAndDescription( _
ByVal titlesRange As Range, ByVal descriptionRange As Range, _
ByVal startCellOnDestination As Range)
Dim title As Range
Dim descr As Range
Dim offsetCtr As Long
Dim formulaTemplate As String
Dim newFormula As String
formulaTemplate = "=CONCATENATE([1], '(', [2], ')')"
startCellOnDestination.Worksheet.EnableCalculation = False
For Each title In titlesRange.Cells
For Each descr In descriptionRange.Cells
If title.Value <> "" And descr.Value <> "" Then
newFormula = Replace(formulaTemplate, "[1]", _
title.Address(External:=True))
newFormula = Replace(newFormula, "[2]", _
descr.Address(External:=True))
newFormula = Replace(newFormula, "'", Chr(34))
startCellOnDestination.Offset(0, offsetCtr).Formula = newFormula
offsetCtr = offsetCtr + 1
End If
Next
Next
startCellOnDestination.Worksheet.EnableCalculation = True
End Sub
Here is how to call the above procedure
GenerateAndPasteFormulaForTitleAndDescription _
Sheets("Compensation, 3").Range("B6:B500"), _
Sheets("Compensation, 3").Range("C5:AAA5"), _
Sheets("new sheet").Range("B5")
EDIT: The code loops through combination of title and description, checks if both of them aren't empty and creates a formula. It pastes the formula into the start cell (Sheets("new sheet").Range("B5") in this case) and moved ahead and pastes the next formula in the column next to it
Basically, you are trying to use VBA objects in worksheet functions. It doesn't quite work that way.
Try replacing
"=title.value & "" ("" & descr.value & "")"""
with
=title.value & " (" & descr.value & ")"