I have a data set, exported from a SharePoint into Excel that we generate various charts from.
I need to simplify the "category names" because, in some cases, they are super long and make charts look terrible. These category names are known by folks in my office by much shorter acronyms, so changing them to these acronyms would be OK. I have probably 15 category names + replacement acronyms.
I'd like to loop through all the charts in a workbook and, for example, do something like this:
"AAAA, 45%", change it to "AA, 45%"
"BBBB, 22%", change it to "BB, 22%"
"CCCC, 67%", change it to "CC, 67%"
Some basic Google fu has produced a basic loop (below, but not working), but I'm not familiar enough with chart and label objects to take the next step and make edits to the category labels. Obviously, I only want to alter the category, not the calculated value - the percentage in the above examples. Can anyone assist?
With ActiveChart
For k = 1 To .SeriesCollection.Count
For j = 1 To .SeriesCollection(k).Points.Count
If .SeriesCollection(k).Points(j).DataLabel.Caption = "AAAA" Then
.SeriesCollection(k).Points(j).DataLabel.Caption = "AA"
End If
Next j
Next k
End With
One idea might be the Replace function.
This can probably be made more robust, but should get you started:
Sub ShortenLabels()
Dim k As Long, j As Long
With ActiveChart
For k = 1 To .SeriesCollection.Count
For j = 1 To .SeriesCollection(k).Points.Count
With .SeriesCollection(k).Points(j).DataLabel
.Caption = Replace(.Caption, "AAAA", "AA")
.Caption = Replace(.Caption, "BBBB", "BB")
.Caption = Replace(.Caption, "CCCC", "CC")
End With
Next j
Next k
End With
End Sub
Related
I have a stacked column graph and i want to hide/show some of the categories on certain conditions. All solutions, i've found, work for series, but in need for categories.
Thank you in advance.
I recorded a macro while I filtered my chart to hide category 2, and here's what the recorder gave me:
ActiveChart.ChartGroups(1).FullCategoryCollection(2).IsFiltered = True
I found a workaround. However, maybe somebody has a more elegant solution, it would be much appreciated.
1st i swap series and categories.
chartSheet.ChartObjects("chart").Chart.PlotBy = xlColumns
2nd then i check which column is hidden and save an index for FullSeriesCollection. With a little convoluted way to get the sheet name and column address, where the data is located.
Dim i As Long, k As Long
Dim tmp() As Variant
Dim sh As String, col As String
For i = 1 To Sheet2.ChartObjects("tst").Chart.SeriesCollection.Count
If Worksheets(Split(Split(Sheet2.ChartObjects("tst").Chart.SeriesCollection(i).Formula, ",")(2), "!")(0)) _
.Range(Split(Split(Sheet2.ChartObjects("tst").Chart.SeriesCollection(i).Formula, ",")(2), ":")(1)).EntireColumn.Hidden = True Then
k = k + 1
ReDim Preserve tmp(1 To k)
tmp(k) = i
End If
Next i
3rd after that i run through all the hidden columns and hide the corresponding data. I couldn't combine 2nd and 3rd, because if any other column, then the last one, is hidden, vba gives an error. Since it tries to access SeriesCollection, which does not exits anymore.
For i = 1 To UBound(tmp)
chartSheet.ChartObjects("chart").Chart.FullSeriesCollection(tmp(i)).IsFiltered = True
Next i
4th and lastly i flip series and categories back around.
chartSheet.ChartObjects("chart").Chart.PlotBy = xlRows
I have working code which selects single items from a slicer, however it doesn't work for multiple items.
The selection is set up by reading which cells in a range are in bold, and populating an array of strings, STP(46), populating up until STP(k). This works fine.
Then the code is supposed to deselect all items in the slicer which aren't in STP, and select those which are. This works for one selection but not for multiple selections - it erroneously selects all items up until the last item to be selected.
With ActiveWorkbook.SlicerCaches("Slicer_STP_Name")
For i = 1 To .SlicerItems.Count
For j = 1 To k
If .SlicerItems(i).Selected And .SlicerItems(i).Caption <> STP(j) Then .SlicerItems(i).Selected = False
Next j
Next i
For i = 1 To .SlicerItems.Count
For j = 1 To k
If .SlicerItems(i).Caption = STP(j) Then .SlicerItems(i).Selected = True: Exit For
Next j
Next i
End with
So instead of selecting, say, the 2nd and 4th item in the slicer, it selects the 1st, 2nd, 3rd, 4th, and deselects the rest.
I need to use a looped technique like this because I need to be able to use this code with multiple slicers with different cache names but the same list of items.
I've looked everywhere, and the code above is even from a solution from another question on here. Any help greatly appreciated!
You can use a dictionary to make the process a little more smooth
With ActiveWorkbook.SlicerCaches("Slicer_test_id")
Dim i
For i = 1 To .SlicerItems.Count
If .SlicerItems(i).Selected And Not stp.Exists(.SlicerItems(i).Caption) Then
.SlicerItems(i).Selected = False
End If
Next i
For i = 1 To .SlicerItems.Count
If stp.Exists(.SlicerItems(i).Caption) Then
.SlicerItems(i).Selected = True
End If
Next i
End With
I'm not totally clear on why you need the first loop. I'm reading "Then the code is supposed to deselect all items in the slicer which aren't in STP, and select those which are." as "select only those otems in STP and deselect all others" which this reduced code will do:
With ActiveWorkbook.SlicerCaches("Slicer_test_id")
Dim i
For i = 1 To .SlicerItems.Count
.SlicerItems(i).Selected = stp.Exists(.SlicerItems(i).Caption)
Next i
End With
populating the Dictionary is super easy
Dim stp As New Dictionary
stp.Add "73148", "73148"
stp.Add "73150", "73150"
stp.Add "73159", "73159"
You need to reference the Microsoft Scripting Runtime
note that if you don't see Microsoft Scripting Runtime in the list you can Browse to C:\Windows\SysWOW64\scrrun.dll
I'm going to be building a userform to be called by a macro in Excel 2013 to restore some values from a spreadsheet, and I need the comboboxes to populate based on the existing values. Populating by range is easy enough, that's working fine, but of course they're all jumbled up and frequently duplicated multiple times. In short, I'm getting this:
Charlie
Quebec
Echo
Zulu
Alpha
Quebec
...when what I want is:
Alpha
Charlie
Echo
Quebec
Zulu
I already have dynamic ranges set up for each of the source ranges.
What would be the most efficient way to handle it?
EDIT: More details.
The sets of data are held in the "Saved Schedules" sheet, each set to a row. At the moment I'm using the Vessel Name column (C). The idea is to select filters to narrow the list down, then select the specific voyage in Voyage Code up at the top of the form. (The yellow fields down the right preview the data so the operators see what they're about to load.) In essence, the basic data is in a sheet, filtered on the fly by the filter options in the userform, and the resulting voyage codes fed to the Voyage Code combobox for selection.
EDIT: I've tried Doug Coats' suggestions, edited as follows to apply to my form:
EDIT AGAIN: Corrected init sub name.
Private Sub UserForm_Initialize()
Me.Combo_Rest_VoyageCode.List = wsSaves.Range("SAVE_VoyageCode").Value ' VOYAGE CODE
Dim Ray, i As Integer, j As Integer, Temp As String
With Combo_Rest_VoyageCode
Ray = Application.Transpose(.List)
For i = 1 To UBound(Ray) - 1
For j = i To UBound(Ray)
If Ray(j) < Ray(i) Then
Temp = Ray(i)
Ray(i) = Ray(j)
Ray(j) = Temp
End If
Next j
Next i
.List = Ray
End With
End Sub
It doesn't meet with any more success, though. Is there anything there that doesn't apply to ActiveX comboboxes, perhaps?
a quick google search found tons of great information
you can alter this code to work with comboxes easily
here is a great link
http://dailydoseofexcel.com/archives/2004/05/12/sorting-listboxes/
Private Sub CommandButton2_Click()
Dim Ray, i As Integer, j As Integer, Temp As String
With ListBox1
Ray = Application.Transpose(.List)
For i = 1 To UBound(Ray) - 1
For j = i To UBound(Ray)
If Ray(j) < Ray(i) Then
Temp = Ray(i)
Ray(i) = Ray(j)
Ray(j) = Temp
End If
Next j
Next i
.List = Ray
End With
End Sub
Hello,
I have found that
=IF(AND(C4>C3,C4>C5),"Local maxima","")
along with:
Sub CustomLabels()
Dim i, myCount, pt
ActiveSheet.ChartObjects("myChart").Activate
myCount = ActiveChart.SeriesCollection(1).Points.Count
For i = 1 To myCount
ActiveChart.SeriesCollection(1).Points(i).ApplyDataLabels
ActiveChart.SeriesCollection(1).Points(i).DataLabel.Text = Range("D" & i + 1).Value
Next i
End Sub
Yields something that looks like this:
What I would like to do is get those labels that say "max" to say the actual values, preferably the x and y values, but just the y works too. Additionally it would be nice to print those maxima to a few cells at the top of the page. Finally, since there are 10000 values, I need to find a way to filter out the "noise." I have a dilemma. If it is impossible then I understand, but I would appreciate any help.
All the best,
N
I am searching/trying to make a macro to fix the position of data labels in a line chart with one or multiple series collections so that they will not overlap each other.
I was thinking of some ways for my macro but when I try to make it I understand that this is way too hard for me and I get headache.
Is there anything that I missed? Do you know about such a macro?
Here's an example chart with overlapped data labels:
Here's an example chart where I manually fixed the data labels:
This task basically breaks down to two steps: access the Chart object to get the Labels, and manipulate the label positions to avoid overlap.
For the sample given all series are plotted on a common X-axis and the X values are sufficiently spread that labels don't overlap in this dimension. Therefore the solution offered only deals with groups of labels for each X point in turn.
Accessing the Labels
This Sub parses the chart and creates an array of Labels for each X point in turn
Sub MoveLabels()
Dim sh As Worksheet
Dim ch As Chart
Dim sers As SeriesCollection
Dim ser As Series
Dim i As Long, pt As Long
Dim dLabels() As DataLabel
Set sh = ActiveSheet
Set ch = sh.ChartObjects("Chart 1").Chart
Set sers = ch.SeriesCollection
ReDim dLabels(1 To sers.Count)
For pt = 1 To sers(1).Points.Count
For i = 1 To sers.Count
Set dLabels(i) = sers(i).Points(pt).DataLabel
Next
AdjustLabels dLabels ' This Sub is to deal with the overlaps
Next
End Sub
Detect Overlaps
This calls AdjustLables with an array of Labels. These labels need to be checked for overlap
Sub AdjustLabels(ByRef v() As DataLabel)
Dim i As Long, j As Long
For i = LBound(v) To UBound(v) - 1
For j = LBound(v) + 1 To UBound(v)
If v(i).Left <= v(j).Left Then
If v(i).Top <= v(j).Top Then
If (v(j).Top - v(i).Top) < v(i).Height _
And (v(j).Left - v(i).Left) < v(i).Width Then
' Overlap!
End If
Else
If (v(i).Top - v(j).Top) < v(j).Height _
And (v(j).Left - v(i).Left) < v(i).Width Then
' Overlap!
End If
End If
Else
If v(i).Top <= v(j).Top Then
If (v(j).Top - v(i).Top) < v(i).Height _
And (v(i).Left - v(j).Left) < v(j).Width Then
' Overlap!
End If
Else
If (v(i).Top - v(j).Top) < v(j).Height _
And (v(i).Left - v(j).Left) < v(j).Width Then
' Overlap!
End If
End If
End If
Next j, i
End Sub
Moving Labels
When an overlap is detected you need a strategy that move one or both labels without creating another overlap.
There are many possibilities here, you havn'e given sufficient details to judge your requirements.
Note about Excel
For this approach to work you need a version of Excel that has DataLabel.Width and DataLabel.Height properties. Version 2003 SP2 (and, presumably, earlier) does not.
This macro will prevent overlapping labels on 2 line charts when data source is listed in two adjacent columns.
Attribute VB_Name = "DataLabel_Location"
Option Explicit
Sub DataLabel_Location()
'
'
' *******move data label above or below line graph depending or other line graphs in same chart***********
Dim Start As Integer, ColStart As String, ColStart1 As String
Dim RowStart As Integer, Num As Integer, x As Integer, Cell As Integer, RowEnd As Integer
Dim Chart As String, Value1 As Single, String1 As String
Dim Mycolumn As Integer
Dim Ans As String
Dim ChartNum As Integer
Ans = MsgBox("Was first data point selected?", vbYesNo)
Select Case Ans
Case vbNo
MsgBox "Select first data pt then restart macro."
Exit Sub
End Select
On Error Resume Next
ChartNum = InputBox("Please enter Chart #")
Chart = "Chart " & ChartNum
ActiveSheet.Select
ActiveCell.Select
RowStart = Selection.row
ColStart = Selection.Column
ColStart1 = ColStart + 1
ColStart = ColNumToLet(Selection.Column)
RowEnd = ActiveCell.End(xlDown).row
ColStart1 = ColNumToLet(ActiveCell.Offset(0, 1).Column)
Num = RowEnd - RowStart + 1
With ThisWorkbook.ActiveSheet.Select
ActiveSheet.ChartObjects(Chart).Activate
ActiveChart.SeriesCollection(1).ApplyDataLabels
ActiveChart.SeriesCollection(2).ApplyDataLabels
End With
For x = 1 To Num
Value1 = Range(ColStart & RowStart).Value
String1 = Range(ColStart1 & RowStart).Value
If Value1 = 0 Then
ActiveSheet.ChartObjects(Chart).Activate
ActiveChart.SeriesCollection(1).DataLabels(x).Select
Selection.Delete
End If
If String1 = 0 Then
ActiveSheet.ChartObjects(Chart).Activate
ActiveChart.SeriesCollection(2).DataLabels(x).Select
Selection.Delete
End If
If Value1 <= String1 Then
ActiveSheet.ChartObjects("Chart").Activate
ActiveChart.SeriesCollection(1).DataLabels(x).Select
Selection.Position = xlLabelPositionBelow
ActiveChart.SeriesCollection(2).DataLabels(x).Select
Selection.Position = xlLabelPositionAbove
Else
ActiveSheet.ChartObjects("Chart").Activate
ActiveChart.SeriesCollection(1).DataLabels(x).Select
Selection.Position = xlLabelPositionAbove
ActiveChart.SeriesCollection(2).DataLabels(x).Select
Selection.Position = xlLabelPositionBelow
End If
RowStart = RowStart + 1
Next x
End Sub
'
' convert column # to column letters
'
Function ColNumToLet(Mycolumn As Integer) As String
If Mycolumn > 26 Then
ColNumToLet = Chr(Int((Mycolumn - 1) / 26) + 64) & Chr(((Mycolumn - 1) Mod 26) + 65)
Else
ColNumToLet = Chr(Mycolumn + 64)
End If
End Function
Allthough I agree that regular Excel formulas can't fix everything, I dislike VBA. There are several reasons for this, but the most important one is that chances are it will stop working with the next upgrade. I'm not saying you shouldn't use VBA at all, but only use it when necessary.
Your question is a good example of a need where VBA isn't necessary.. "OK" you say, "but then how do I fix this problem?" Feel lucky and click this link to my answer to a related question here.
What you'll find out in the link is, how you can measure your charts' exact grid. When your x-axis crosses at 0, you'll only need the maximum Y-axis label for that. You're only half way there now, cause your specific problem isn't solved yet. Here's how I would proceed:
First measure how high your labels are compared to the height of your chart. This will need some trial and error, but shouldnt be very difficult. If your chart can stack 20 labels without overlapping, this number would be 0.05 for example.
Next determine if and where any of the labels would overlap. This is quite easy, cause all you need to do is find out where numbers are too close to each other (within the 0.05 range in my example).
Use some boolean tests or for all I care IF formulas to find out. The result you're after is a table with the answers for each of the series (except the first one). Don't be afraid to duplicate that table again for the next step: creating the new chart input.
There are several ways to create the new chart, but here's the one I'd choose. For each of the series create three lines. One is the actual line, the other two are the invisible lines with just the data labels. For each of the lines there is one invisible line with just the regular labels. Those all use the same alignment. Each extra invisible line has a different allignment for the labels. You won't need one for your first series, but for the second one the label would be to the right, the third one beneath and the fourth one to the left (for example).
When none of the data labels overlap only the first invisible lines (with regular alignment) need to show the values. When labels do overlap, the corresponding extra invisible line should take over on that point and show its label. Of course the first invisible line should not show one there.
When all four labels overlap at the same x-axis value, you should see the first basic invisible line's label and the three extra invisible lines' labels. This should work for your example chart, cause there is enough room to move to labels to the left and right. Personally I'd stick with just the minimum and the maximum label at an overlapping point, cause the fact it overlaps shows the values are pretty close to each other in the first place..
I hope this helped you,
Greetings,
Patrick
#chris neilsen
Could you test your solution on Excel 2007?
When I cast the objects to DataLabel class, it looks like the .Width property has been removed from the class.
(Sorry, I was not permitted to comment on your reply)
Maybe one thing to add from below forum is to temporary adjust position of label:
http://www.ozgrid.com/forum/showthread.php?t=90439
"you get close width or height value of the data label by forcing the label off of the chart and comparing the reported left/top value to that of the chartarea inside width/height."
Based on this, please move v(i).Width & v(j).Width to a variables sng_vi_Width & sng_vj_Width and add these lines
With v(i)
sngOriginalLeft = .Left
.Left = .Parent.Parent.Parent.Parent.ChartArea.Width
sng_vi_Width = .Parent.Parent.Parent.Parent.ChartArea.Width - .Left
.Left = sngOriginalLeft
End With
With v(j)
sngOriginalLeft = .Left
.Left = .Parent.Parent.Parent.Parent.ChartArea.Width
sng_vj_Width = .Parent.Parent.Parent.Parent.ChartArea.Width - .Left
.Left = sngOriginalLeft
End With