VBA for Adding and Deleting Data Labels

I'm currently working on a project where I have multiple embedded line charts in a workbook. Each line chart contains any number of multiple series. Each series contains 12 points representing each month of the year. For each chart I need to show the data points for the current month only.

Although the combination Line - XY Scatter chart works, I want to use VBA to add and delete the data labels in each chart in an effort to minimize the number of chart series that the owner of the workbook needs to maintain. Below are some simple macros for adding and deleting data labels that I've used for reference and / or utilized in my project. Each example works for the active chart only (an active single embedded chart).

To delete a label from a single series:

Sub Delete_Labels_From_A_Single_Series()
    For Each X In ActiveChart.SeriesCollection(1).Points
        X.DataLabel.Delete
    Next X
End Sub

A second method for deleting a label from a single series:

Sub Delete_Labels_From_A_Single_Series()
    
    Dim Cht As Chart
    Dim Srs As Series
    
    Set Cht = ActiveChart
    Set Srs = Cht.SeriesCollection(1)
    
        With Srs
            If .HasDataLabels Then .DataLabels.Delete
        End With

End Sub

To add data labels to multiple series at one time:

Sub Add_Data_Labels_To_All_Series()
    
    Dim Cht As Chart
    
    Set Cht = ActiveChart
    
    For Each Sr In Cht.SeriesCollection
        Sr.ApplyDataLabels
        Sr.DataLabels.ShowValue = True
        Sr.DataLabels.Position = xlLabelPositionAbove
    Next Sr

End Sub

To delete data labels from multiple series at one time:

Sub Delete_Data_Labels_From_All_Series()
    
    Dim Cht As Chart
    
    Set Cht = ActiveChart
    
    For Each Sr In Cht.SeriesCollection
        If Sr.HasDataLabels Then Sr.DataLabels.Delete
    Next Sr

End Sub

Removing Spaces from File Names

For a number of reasons I prefer to never use spaces in file names. Recently Dick Kuslieka at the Daily Dose of Excel posted an interesting VBA technique for removing spaces from file names. John Walkenbach commented with a revision that will allow the same functionality using Excel 2007 and Rick Rothstein commented with another alternative. These snippets are great additions to my VBA toolbox.

Dick's Kuslieka's original post:

Sub RemoveSpaces()
    
    Dim fso As FileSystemObject
    Dim fsoFile As File
    
    Set fso = New FileSystemObject
    
    For Each fsoFile In fso.GetFolder("C:\Tester").Files
        If InStr(1, fsoFile.Name, " ")> 0 Then
            fsoFile.Name = Replace(fsoFile.Name, " ", "_")
        End If
    Next fsoFile
    
End Sub

John Walkenbach's version for Excel 2007:

Sub RemoveSpaces()
    Const Folder As String = "C:\Tester\"
    Dim FileName As String, NewName As String
    FileName = Dir(Folder)
    Do While FileName  ""
        If InStr(1, FileName, " ")> 0 Then
            NewName = Replace(FileName, " ", "_")
            Name Folder & FileName As Folder & NewName
        End If
        FileName = Dir
    Loop
End Sub

and Rick Rothstein commented with another version:

Sub RemoveSpaces()
  Dim Path As String, FileName As String
  Path = "C:\Tester\"  'Note the trailing backslash
  FileName = Dir(Path & "*.*")
  Do While FileName  ""
    Name Path & FileName As Path & Replace(FileName, " ", "_")
    FileName = Dir
  Loop
End Sub

Arrays to Calculate Consistent Increases in Rate Spreads

Every year at work we go through a planning cycle for the following year. During that time we build an annual and five year plan. After those plans are approved and submitted, we revisit the annual plan and spread those results across each month of the year. We then do a second submission of monthly results.

In going through that process, I've struggled to explain why the following calculation doesn't work . . .

In the example below we're given the total planned 2010 volume (in the yellow cell) that we need to spread. The spread needs to be based on a consistent or even growth in the rate per work day. We have history for volume in 2009 and workdays for 2009 and 2010 as well. Below is a screenshot of what we know.

On the surface this seems to be a simple algebra problem. Knowing the total planned volume for 2010 and having 2009 as a base, the spread should be an easy calculation using the 6-month average volume per workday.

Using this logic, the calculation above now looks like this:

In the range J12:J14, a rate per workday has been calculated for both years. The change in the rate is applied to each month (range D12:I14). Finally, the 2010 rate per workday (range D13:I13) is multipled by the workdays (range D9:I9) to get the volume for each month (range D5:I5).

All of this seems to make sense until you sum the range D5:I5. Instead of getting a total volume of 85,265, the actual total volume is 83,345. The total volume is overstated by 80 units, or 0.09%.

To correct this error, instead of using the increase in the total volume per workday and then applying that increase to each month, an array formula can be used. Referencing the screenshot below:

the following array formula is entered into the green shaded range D13:I13 (using CNTL - SHIFT - ENTER at the same time to enter the array formula):

{=J5 / SUM((D4:I4)/(D8:I8)*(D9:I9)) * (D12:I12)}

Now when you sum the range D5:I5 the total volume ties to 85,265. However, the monthly change in the rate is now 4.77% which does not agree with the 6-month average change of 4.87%. The difference is due to how the array formula evaluates each individual month and then totals the results.

Show Gridlines when Filling an Interior Range

Dick Kuslieka at the Daily Dose of Excel recently posted a macro that allows the user to create the illusion of gridlines when filling an interior worksheet range. Thinking this a good addition to my Excel toolbox, I've copied it from Dick's site for reference.

Sub ColorRange()
    
    With Selection
        Selection.BorderAround xlContinuous, xlThin, , RGB(192, 192, 192)
        If .Columns.Count> 1 Then
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(192, 192, 192)
            End With
        End If
        If .Rows.Count> 1 Then
            With .Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(192, 192, 192)
            End With
        End If
    End With
    
End Sub

Delete All Embedded Charts from a Workbook

Earlier this week a coworker approached me with a workbook that she needed help with. Although the workbook appeared to contain only text values, it was prompting to update links every time it was opened. Upon using Bill Manville's FindLink Utility, we were able to find links to embedded charts that had been hidden somewhere in the workbook. Since she didn't need the charts, we used the following macro to delete all of the embedded charts in her workbook.

Sub Loop_Thru_Embedded_Chart_Objects()
    Dim Sht As Worksheet
    Dim ChtObj As ChartObject
    For Each Sht In ActiveWorkbook.Sheets
        For Each ChtObj In Sht.ChartObjects
            ChtObj.Delete
        Next ChtObj
    Next Sht
End Sub