Home > Mobile >  Extracting multiple files from folder to graph on the same plot
Extracting multiple files from folder to graph on the same plot

Time:07-26

My issue is that I can't seem to find a way to plot the data from the files that I've separated into sheets. There would be the same 2 columns in each sheet but with different values. Each sheet would represent a different series on the plot. I am new to vba so any insight into what direction I should take would be great. In addition, seeing as separating the files into sheets might not be the most efficient way to go about this, would compiling it all into a single sheet and graphing that be the better way to go? Because I ran into the issue of finding a way to differentiate between the sets of data from each file and it ended up turning into one single series instead of multiple series on the same plot. Any help would be greatly appreciated. And if I have dumped too many issues into one post, I apologize in advance. This is what my data looks like.

Below is what I have managed to collect from my research so far:

This is what I used to extract files and place them on separate sheets

Dim FilesToOpen   
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String

Application.ScreenUpdating = False

FilesToOpen = Application.GetOpenFilename _
  (FileFilter:="Microsoft Excel Comma Separated Values File (*.csv), *.csv", _
  MultiSelect:=True, Title:="Files to Open")

If TypeName(FilesToOpen) = "Boolean" Then
    MsgBox "No Files were selected"
End If

x = 1
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
wkbTemp.Sheets(1).Copy
Set wkbAll = ActiveWorkbook
wkbTemp.Close (False)

x = x   1

While x <= UBound(FilesToOpen)
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    With wkbAll
        wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)

    End With
    x = x   1
Wend

Application.ScreenUpdating = True

I use this to remove unwanted rows from csv files. I messed around with trying to get anything above Wavelength without specifying a range of rows, but did not have any luck

Dim CurrentSheet As Object  

 For Each CurrentSheet In ActiveWorkbook.Worksheets
    CurrentSheet.Range("a1:b18").EntireRow.Delete
 Next CurrentSheet



Dim cht As Chart, s As Series, xRng As Range
Dim j As Long, chartName As String

Set cht = Charts.Add
cht.ChartType = xlLine
cht.Location Where:=xlLocationAsNewSheet, Name:="Chart"

For j = 1 To WS_Count

My attempt at graphing the data

    chartName = "Sheet" & j
    Set xRng = Sheets(chartName).Range("A2:A")

    With cht.SeriesCollection.NewSeries()
        .Values = xRng
        .Name = chartName
    End With

Next j

CodePudding user response:

Try this out (untested, but should be close):

Sub PlotSelectedFiles()
    Dim colFiles As Collection, f, wbAll As Workbook, wbTemp As Workbook, ws As Worksheet
    Dim cht As Chart, cDest As Range, wl As Range, rngData As Range, numRows As Long, rngX As Range
    
    Set colFiles = GetCsvFiles()
    If colFiles.Count = 0 Then
        MsgBox "No files were selected"
        Exit Sub
    End If
    
    'create a new single-sheet workbook
    Set wbAll = Workbooks.Add(template:=xlWBATWorksheet)
    With wbAll.Sheets(1)
        .Name = "All Data"
        Set cDest = .Range("A1")
    End With
    'add a chart
    Set cht = wbAll.Charts.Add(after:=wbAll.Sheets(1))
    cht.ChartType = xlLine
    cht.Name = "Chart"
    
    'loop over the selected files
    For Each f In colFiles
        Set wbTemp = Workbooks.Open(Filename:=f)
        Set ws = wbTemp.Sheets(1)
        Set wl = ws.Columns("A").Find("Wavelength", lookat:=xlWhole)
        If Not wl Is Nothing Then       'found "Wavelength" ?
            cDest.Value = wbTemp.Name   'record the source file name
            
            Set rngData = ws.Range(wl, ws.Cells(Rows.Count, wl.Column).End(xlUp).Offset(0, 1))
            rngData.Copy cDest.Offset(1)       'copy data over
            numRows = rngData.Rows.Count - 1   'rows of data (`rngData` includes headers)
            Set rngX = cDest.Offset(2, 0).Resize(numRows)
            With cht.SeriesCollection.NewSeries 'plot the data
                .Name = cDest.Value
                .XValues = rngX.Value
                .Values = rngX.Offset(0, 1).Value
            End With
            
            Set cDest = cDest.Offset(0, 2) 'move paste range over
        Else
            MsgBox "No 'Wavelength' in file '" & wbTemp.Name & "'", vbExclamation
        End If 'found wavelength
        wbTemp.Close savechanges:=False
    Next f
End Sub


Function GetCsvFiles() As Collection
    Dim FilesToOpen, col As New Collection, i As Long
    FilesToOpen = Application.GetOpenFilename _
        (FileFilter:="Microsoft Excel Comma Separated Values File (*.csv), *.csv", _
               MultiSelect:=True, title:="Files to Open")
        
    If TypeName(FilesToOpen) <> "Boolean" Then
        For i = LBound(FilesToOpen) To UBound(FilesToOpen)
            col.Add FilesToOpen(i)
        Next i
    End If
    Set GetCsvFiles = col
End Function
  • Related