Dynamic referencing the UsedRange in VBA

2019-08-01 19:23发布

I have a code that gets data from a sheet and creates a graph. In the source sheet, each column is a series, and the number of series may change.

What my code does: it reads the used ranges so that it can graph the values.

Obs1: For 2 of the time series I create, the data is annualized, so as I count backwards for the calculation, if the data before is less than one year, the code shows as "Not Enough Data".

Problem: If I run the code with 2 time series (2 columns), I get two lines in the charts. But if I then delete one of the series and run it again, I get one line with values and a second empty line in the chart.

Question: How can this problem be solved?

What I already tried: I am trying to change the way I reference the ranges, so that it rerun the code, it returns to the graph only lines that have values. Issue is I cannot find a way to properly reference the range like that.

Relevant part of the code:

Function Grapher(ChartSheetName As String, SourceWorksheet As String, ChartTitle As String, secAxisTitle As String)

Dim lColumn As Long, lRow As Long
Dim LastColumn As Long, LastRow As Long
Dim RetChart As Chart
Dim w As Workbook
Dim RetRange As Range
Dim chrt As Chart
Dim p As Integer
Dim x As Long, y As Long
Dim numMonth As Long
Dim d1 As Date, d2 As Date
Dim i As Long

Set w = ThisWorkbook

'find limit
LastColumn = w.Sheets(SourceWorksheet).Cells(1,   w.Sheets(SourceWorksheet).Columns.Count).End(xlToLeft).column
LastRow = w.Sheets(SourceWorksheet).Cells(w.Sheets(SourceWorksheet).Rows.Count, "A").End(xlUp).Row

'check for sources that do not have full data
'sets the range
i = 3
If SourceWorksheet = "Annualized Ret" Or SourceWorksheet = "Annualized Vol" Then

    Do While w.Worksheets(SourceWorksheet).Cells(i, 2).Text = "N/A"

        i = i + 1

    Loop

'##### this is the part I believe is giving the problem:
    '##### the way to reference the last cell keeps getting the number of columns (for the range) from the original column count. 

    Set RetRange =    w.Worksheets(SourceWorksheet).Range(w.Worksheets(SourceWorksheet).Cells(i, 1), w.Worksheets(SourceWorksheet).Cells.SpecialCells(xlLastCell)) '****************

Else

    Set RetRange = w.Sheets(SourceWorksheet).UsedRange

    'Set RetRange = w.Sheets(SourceWorksheet).Range("A1:" &   Col_Letter(LastColumn) & LastRow)

End If

'''''''''''''''''''''''

For Each chrt In w.Charts
    If chrt.Name = ChartSheetName Then
        Set RetChart = chrt
        RetChart.Activate
        p = 1
    End If
Next chrt

If p <> 1 Then
    Set RetChart = Charts.Add
End If

'count the number of months in the time series, do the ratio
d1 = w.Sheets(SourceWorksheet).Range("A2").Value
d2 = w.Sheets(SourceWorksheet).Range("A" & LastRow).Value

numMonth = TestDates(d1, d2)

x = Round((numMonth / 15), 1)

'ratio to account for period size
If x < 3 Then
    y = 1
ElseIf x >= 3 And x < 7 Then
    y = 4
ElseIf x > 7 Then
    y = 6
End If

'create chart
        With RetChart
            .Select
            .ChartType = xlLine
            .HasTitle = True
            .ChartTitle.Text = ChartTitle
            .SetSourceData Source:=RetRange
            .Axes(xlValue).MaximumScaleIsAuto = True
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date"
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text =  secAxisTitle
            .Name = ChartSheetName
            .SetElement (msoElementLegendBottom)
            .Axes(xlCategory).TickLabelPosition = xlLow
            .Axes(xlCategory).MajorUnit = y
            .Axes(xlCategory).MajorUnitScale = xlMonths

'sets header names for modified sources
            If SourceWorksheet = "Drawdown" Then
                For lColumn = 2 To LastColumn

                    .FullSeriesCollection(lColumn - 1).Name = "=DD!$" & Col_Letter(lColumn) & "$1"
                    .FullSeriesCollection(lColumn - 1).Values = "=DD!$" & Col_Letter(lColumn) & "$3:$" & Col_Letter(lColumn) & "$" & LastRow

                Next lColumn

            ElseIf SourceWorksheet = "Annualized Ret" Then
                For lColumn = 2 To LastColumn

                    .FullSeriesCollection(lColumn - 1).Name = "='Annualized Ret'!$" & Col_Letter(lColumn) & "$1"

                Next lColumn

            ElseIf SourceWorksheet = "Annualized Vol" Then
                For lColumn = 2 To LastColumn

                    .FullSeriesCollection(lColumn - 1).Name = "='Annualized Vol'!$" & Col_Letter(lColumn) & "$1"

                Next lColumn

            End If

        End With

End Function

Obs2: My code is currently functional (there are some functions I haven't added, so as not to waste more space).

Obs3: This is the problem when I decrease the number of columns (data series):enter image description here

1条回答
够拽才男人
2楼-- · 2019-08-01 20:24

Since I could find no better, more elegant way to approach this problem (even the tables where yielding the same error), I corrected, by explicitly deleting the extra series in the end, based on their names.

Obs: If the Series contained no data, the new inserted code will change that series name to one of the ones below, and delete that series altogether.

Code to be added to the end:

'deleting the extra empty series
        Dim nS As Series
        'this has to be fixed. For a permanent solution, try to use tables
        For Each nS In RetChart.SeriesCollection
            If nS.Name = "Series2" Or nS.Name = "Series3" Or nS.Name = "Series4" Or nS.Name = "Series5" Or nS.Name = "Series6" Or nS.Name = "Series7" Or nS.Name = "Series8" Or nS.Name = "" Then
                nS.Delete
            End If
        Next nS
查看更多
登录 后发表回答