Excel macro - Plot multiple wells' records on single chart

[wwj]

- User input for a sheet name.

Code: Select all

Sub plot_MultiWells()

    Dim listSheet As String
    Dim dataSheet As String
    Dim plotSheet As String
    Dim wellID As String
    
    Dim IndexKey As String
    Dim IndexXXX As String
    
    Dim i As Integer
    Dim j As Integer
    Dim numGraph  As Integer
    Dim maxGraph  As Integer
    Dim maxNumList  As Integer
    Dim maxNumPlot As Integer
    Dim lastRow As Integer
    
    Dim xaxis As Range
    Dim yaxis As Range


'*********************************************************
    dataSheet = "FormedData"
    plotSheet = "CompareHw"  ' Compare multi-well data
    listSheet = "TRTargetList"
    maxGraph = 25
    IndexKey = "xxx"
    col4Index = 16 ' "P"
'*********************************************************

    ' Picking a new sheet name.
    swExist = True
    j = 0
    Do While swExist And j < 3
    
        If j > 0 Then
            plotSheet = ""
        End If
        
        plotSheet = InputBox(Prompt:="New sheet name for Graphs", _
              Title:="Enter a name", Default:=plotSheet)
    
        If plotSheet = vbNullString Then
            Exit Sub
        End If
        
        swExist = False
        
        For i = 1 To ActiveWorkbook.Worksheets.Count
            If ActiveWorkbook.Worksheets(i).Name = plotSheet Then
                swExist = True
            End If
        Next i
        
        For i = 1 To ActiveWorkbook.Charts.Count
            If ActiveWorkbook.Charts(i).Name = plotSheet Then
                swExist = True
            End If
        Next i

        j = j + 1   ' Count.
    Loop
    
    If swExist Then
        Exit Sub
    End If
    
    ' Add a new empty chart
    Charts.Add
    ActiveChart.ChartType = xlXYScatterLines
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=plotSheet
    ActiveChart.Move after:=Worksheets(Worksheets.Count)

    ' Search # of lines to be plotted.
    numGraph = 0
    maxNumList = Sheets(listSheet).Cells(Sheets(listSheet).Rows.Count, 1).End(xlUp).Row
    
    ' Add sources for lines
    numGraph = 0
    For i = 2 To maxNumList                   ' Lin 1 = Header
        IndexXXX = Sheets(listSheet).Cells(i, col4Index)
        
        If IndexXXX = IndexKey And numGraph < maxGraph Then
            wellID = Sheets(listSheet).Cells(i, 1)
            
            ' Search the column no. in the data sheet.
            j = 1
            Do While Not wellID = Sheets(dataSheet).Cells(1, j) And j <= maxNumList * 4
                j = j + 4
            Loop
        
            With ActiveChart.SeriesCollection.NewSeries
                .Name = Sheets(dataSheet).Cells(1, j)
                lastRow = Sheets(dataSheet).Cells(Sheets(dataSheet).Rows.Count, 1).End(xlUp).Row
                                
                .XValues = Sheets(dataSheet).Range(Sheets(dataSheet).Cells(3, j), Sheets(dataSheet).Cells(lastRow, j))
                .Values = Sheets(dataSheet).Range(Sheets(dataSheet).Cells(3, j + 1), Sheets(dataSheet).Cells(lastRow, j + 1))
            End With
                        
            numGraph = numGraph + 1
        End If
    Next i
    
    With ActiveChart
           .Axes(xlCategory, xlPrimary).HasTitle = True
           .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time (day)"
           .Axes(xlValue, xlPrimary).HasTitle = True
           .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Hw (ft)"
           .HasLegend = True
    End With
    
    'ActiveChart.Axes(xlValue).MinimumScaleIsAuto = True
    'ActiveChart.Axes(xlValue).MaximumScaleIsAuto = True
    
End Sub