VBA Not Copying Dynamic Graph Range When Importing CSV

[scotboy15]

Hi All,

Hoping someone can help me.

During isolation I've got some spare time and have created an Excel workbook with a macro that when a button is pressed it will allow the user to select a CSV file. The Macro then creates a copy of a "Template" work sheet which contains a Graph that contains dynamic ranges. The import of the CSV works correctly and everything appears fine except the dynamic range of the graph isn't copied across and it reverts to static references. The OFFSET function and things copys across is the name manager but the graphs dynamic range reference does not.

I've been trying this for a huge amount of time and not getting anywhere but am sure it is childs play for some of you Excel/VBA experts.

The excel file can be downloaded here and I have included a sample CSV file for reference: Spreadsheet - Google Drive

The code in the macro is:

Sub GetCSVList()
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker)
With dlgOpen
    .AllowMultiSelect = True
    ''Start in
    .InitialFileName = "C:\Test"
    .Show
End With

For Each fname In dlgOpen.SelectedItems
    ImportCSV fname
Next
End Sub



Sub ImportCSV(fname)
ws = Worksheets("Template").Copy(Before:=Worksheets("Template"))
'Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
ActiveSheet.Name = Mid(fname, InStrRev(fname, "\") + 1)

With ActiveSheet.QueryTables.Add( _
        Connection:="TEXT;" & fname, _
        Destination:=Range("B3"))
    .Name = "Test" & Worksheets.Count + 1
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlOverwriteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = False
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 65001
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .Refresh BackgroundQuery:=False
    '.UseListObject = False
End With

ActiveSheet.Name = Range("L17")
ActiveSheet.Range("B4:G4").Clear
ActiveSheet.Range("E3").Clear
ActiveSheet.Range("A8:A9").EntireRow.Insert
ActiveSheet.Range("B5:C5").Cut Range("B9:C9")
ActiveSheet.Range("C7").Value = "seconds"


End Sub

 

[scotboy15]

This has been solved. The code below needs to be added to the import CSV method:

With ActiveSheet.ChartObjects(1).Chart
    .SeriesCollection(1).Values = "=" & Range("B10", Range("B" & Rows.Count).End(xlUp)).Address(1, 1, xlR1C1, 1)
    .SeriesCollection(2).Values = "=" & Range("C10", Range("C" & Rows.Count).End(xlUp)).Address(1, 1, xlR1C1, 1)
End With