Code: Select all
Sub plot_MultiWells()
Dim listSheet As String
Dim dataSheet As String
Dim plotSheet As String
Dim wellID As String
Dim ChartList(1 To 20) As String
Dim IndexKey As String
Dim IndexXXX As String
Dim maxNumChart As Integer
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
col4Index = 16 ' "P"
'*********************************************************
ChartList(1) = "GRC-0058G"
ChartList(2) = "GRGT-006"
ChartList(3) = "GRGT-008"
ChartList(4) = "GRMW-12"
ChartList(5) = "GRMW-13"
ChartList(6) = "GRMW-14"
ChartList(7) = "GRMW-15"
ChartList(8) = "GRPZ-06"
ChartList(9) = "GRPZ-12"
ChartList(10) = "GRPZ-13"
ChartList(11) = "HCPZ-03"
ChartList(12) = "RHD12-142"
ChartList(13) = "RHPZ-06"
ChartList(14) = "RHPZ-08"
ChartList(15) = "RHPZ-10"
maxNumChart = 15
'*********************************************************
plotSheet = IndexKey ' Compare multi-well data
For ctrChart = 1 To maxNumChart
IndexKey = ChartList(ctrChart)
swExist = False
' Picking a new sheet name.
For i = 1 To ActiveWorkbook.Charts.Count
If ActiveWorkbook.Charts(i).Name = IndexKey Then
swExist = True
End If
Next i
If swExist Then
Application.DisplayAlerts = False
ActiveWorkbook.Charts(IndexKey).Delete
Application.DisplayAlerts = True
End If
plotSheet = IndexKey
'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)
wellID = Replace(wellID, " ", "_")
' 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
' Field data
If wellID = Sheets(dataSheet).Cells(1, j) Then
With ActiveChart.SeriesCollection.NewSeries
.Name = Sheets(dataSheet).Cells(1, j) & "_Obs"
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))
'.Format.Line.Visible = msoFalse
End With
numGraph = numGraph + 1
End If
' Modeled data
If wellID = Sheets(dataSheet).Cells(1, j) Then
With ActiveChart.SeriesCollection.NewSeries
.Name = Sheets(dataSheet).Cells(1, j) & "_Model"
lastRow = Sheets(dataSheet).Cells(Sheets(dataSheet).Rows.Count, 1).End(xlUp).Row
.XValues = Sheets(dataSheet).Range(Sheets(dataSheet).Cells(3, j + 2), Sheets(dataSheet).Cells(lastRow, j + 2))
.Values = Sheets(dataSheet).Range(Sheets(dataSheet).Cells(3, j + 3), Sheets(dataSheet).Cells(lastRow, j + 3))
'.Format.Line.Visible = msoTrue
End With
numGraph = numGraph + 1
End If
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
Next ctrChart
' Message box
MsgBox "Done to plot charts! "
End Sub