Code: Select all
Sub plot_Compare_Cases()
'
' Plot_All Macro
' Update: November 1, 2024
'
Dim initRowPlot As Integer
Dim initCol As Long
Dim rowNo As Long
Dim colNo As Long
Dim dyRow As Long
Dim dataInitRow As Long
Dim dataInitCol As Long
Dim dataRow As Long
Dim dataCol As Long
Dim dataDcol As Long
Dim i As Long
Dim j As Long
Dim numPlots As Long
Dim numPages As Long
Dim lastRow As Long
Dim maxColModelData As Long
Dim colRange As Range
Dim dataSht As String
Dim plotSht As String
Dim listSht As String
Dim chartTitle As String
Dim analysisTitle As String
Dim objCht As ChartObject
Dim objShp As Shape
Dim pgText As TextFrame2
Dim tabName(4) As String
Dim lineColor(5) As Long
lineColor(1) = RGB(0, 0, 255) ' blue
lineColor(2) = RGB(255, 51, 51) ' red
lineColor(3) = RGB(0, 255, 0) ' green
lineColor(4) = RGB(160, 160, 160) ' gray
lineColor(5) = RGB(153, 204, 255) ' sky blue
ThisWorkbook.Activate
'*********************************************************
listSht = "List_SO4"
plotSht = "Comparison"
plotSample = "template_SO4"
analysisTitle = "Sulfate Conc. Targets"
prefix_targetName = "so4" ' prefix for targets.
Sheets("macro").Select
numOfCases = 0
tabName(numOfCases) = "Obs" ' Obs. data
For i = 0 To 3
sw = Sheets("macro").Cells(i + 5, "D")
If sw = "Y" Then
numOfCases = numOfCases + 1
tabName(numOfCases) = Sheets("macro").Cells(i + 5, "C")
End If
Next i
'*********************************************************
plotPerPage = 4 ' 4 graphs per page.
dyRow = 37 ' spaces for 4 graphs per page.
dxCol = 2
initRowPlot = 2
initCol = 9 'I'
swDate = True
'*********************************************************
' Clear all contents
Sheets(plotSht).Select
Sheets(plotSht).Activate
ActiveSheet.Cells.Clear ' Clear all cells.
For Each objCht In ActiveSheet.ChartObjects ' Remove all charts
objCht.Delete
Next
ActiveSheet.DrawingObjects.Delete ' Remove all drawing objects
dataSht = "Case1"
' Set column width
Sheets(plotSht).Columns("A").ColumnWidth = 1.67
Sheets(plotSht).Columns("B:AB").ColumnWidth = 4.43
' Max number in the target list.
lastRowInList = Sheets(listSht).Cells(Rows.Count, "A").End(xlUp).Row
numTargets = lastRowInList - 2
numPlots = numTargets
numPages = numPlots / plotPerPage ' 4 or 8 graphs per page.
If (numPlots > numPages * plotPerPage) Then
numPages = numPages + 1
End If
' Copy the template plot onto the plot sheet.
colNo = 2
For i = 1 To numPages
rowNo = initRowPlot + (i - 1) * dyRow
Sheets(plotSht).Select
ActiveSheet.Cells(rowNo, colNo).Select
Sheets(plotSample).Select
'ActiveSheet.Shapes.Range(Array("Group 1")).Select
ActiveSheet.Shapes.SelectAll
Selection.Copy
Sheets(plotSht).Select
Sheets(plotSht).Cells(rowNo, colNo).Select
Sheets(plotSht).Paste
Next i
ActiveSheet.Range("B1").Select
' Update all observation plot data.
' max column number of formed data
maxColModelData = Sheets(dataSht).Cells(1, Columns.Count).End(xlToLeft).Column
j = 2 ' Header lines in the target list.
plotPage = 1 ' Link for page numbers.
plotCount = 0 ' 4 plot per page.
col4Name = "T"
col4Link = "U"
Sheets(listSht).Cells(2, col4Name) = "Name"
Sheets(listSht).Cells(2, col4Link) = "Link"
For Each objCht In Worksheets(plotSht).ChartObjects
'Debug.Print objCht.Name
ActiveSheet.ChartObjects(objCht.Name).Activate
ActiveChart.chartTitle.Select
' Select target wells
j = j + 1
tgtName = Sheets(listSht).Cells(j, "A") ' Name in Model output.
tgtName = prefix_targetName + tgtName
plotCount = plotCount + 1
If plotCount > plotPerPage Then
plotPage = plotPage + 1
plotCount = 1
End If
' Search the target well data
i = 1 ' Column number for formed data.
Do While Not (tgtName = Sheets(dataSht).Cells(1, i)) _
And i <= maxColModelData
i = i + 4
Loop
If i <= maxColModelData Then
' Observation data
lastRow = Sheets(dataSht).Cells(Rows.Count, i + 1).End(xlUp).Row
chartTitle = Sheets(listSht).Cells(j, "A")
Lyr = Sheets(listSht).Cells(j, "M")
Location = Sheets(listSht).Cells(j, "N")
chartTitle = chartTitle & " (L: " & Lyr & ", " & Location & " )"
Selection.Characters.Text = chartTitle
Selection.Characters.Font.Size = 11
ActiveChart.chartTitle.Left = ActiveChart.ChartArea.Width
ActiveChart.chartTitle.Left = ActiveChart.chartTitle.Left / 2
Selection.Characters.Text = chartTitle
ActiveChart.SeriesCollection(1).Name = chartTitle
ActiveChart.SeriesCollection(1).XValues = _
Sheets(dataSht).Range(Sheets(dataSht).Cells(3, i), Sheets(dataSht).Cells(lastRow, i))
ActiveChart.SeriesCollection(1).Values = _
Sheets(dataSht).Range(Sheets(dataSht).Cells(3, i + 1), Sheets(dataSht).Cells(lastRow, i + 1))
minObsHw = WorksheetFunction.Min(Sheets(dataSht).Range(Sheets(dataSht).Cells(3, i + 1), _
Sheets(dataSht).Cells(lastRow, i + 1)))
maxObsHw = WorksheetFunction.Max(Sheets(dataSht).Range(Sheets(dataSht).Cells(3, i + 1), _
Sheets(dataSht).Cells(lastRow, i + 1)))
' Modeled data
valSht = tabName(1)
lastRow = Sheets(valSht).Cells(Rows.Count, i + 2).End(xlUp).Row
ActiveChart.SeriesCollection(2).XValues = _
Sheets(valSht).Range(Sheets(valSht).Cells(3, i + 2), Sheets(valSht).Cells(lastRow, i + 2))
ActiveChart.SeriesCollection(2).Values = _
Sheets(valSht).Range(Sheets(valSht).Cells(3, i + 3), Sheets(valSht).Cells(lastRow, i + 3))
ActiveChart.SeriesCollection(2).Name = "Case1"
' Other cases - Modeled data
For k = 2 To numOfCases
' Add the additional data series
valSht = tabName(k)
lastRow = Sheets(valSht).Cells(Rows.Count, i + 2).End(xlUp).Row
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(k + 1).XValues = _
Sheets(valSht).Range(Sheets(valSht).Cells(3, i + 2), Sheets(valSht).Cells(lastRow, i + 2))
ActiveChart.SeriesCollection(k + 1).Values = _
Sheets(valSht).Range(Sheets(valSht).Cells(3, i + 3), Sheets(valSht).Cells(lastRow, i + 3))
ActiveChart.SeriesCollection(k + 1).Format.Line.Weight = 1.2 ' Set line thickness
ActiveChart.SeriesCollection(k + 1).Format.Line.DashStyle = msoLineSolid
ActiveChart.SeriesCollection(k + 1).Format.Line.ForeColor.RGB = lineColor(k)
ActiveChart.SeriesCollection(k + 1).MarkerStyle = xlMarkerStyleNone ' Remove symbols
ActiveChart.SeriesCollection(k + 1).Name = valSht ' "=" & valSht
Next k
' Reference line
sw_ref_line = True
If sw_ref_line Then
valSht = plotSample
k = k
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(k + 1).XValues = _
Sheets(valSht).Range(Sheets(valSht).Cells(30, "AF"), Sheets(valSht).Cells(31, "AF"))
ActiveChart.SeriesCollection(k + 1).Values = _
Sheets(valSht).Range(Sheets(valSht).Cells(30, "AG"), Sheets(valSht).Cells(31, "AG"))
ActiveChart.SeriesCollection(k + 1).MarkerStyle = xlMarkerStyleNone ' Remove symbols
ActiveChart.SeriesCollection(k + 1).Format.Line.Weight = 1 ' Set line thickness
ActiveChart.SeriesCollection(k + 1).Format.Line.DashStyle = msoLineSolid
ActiveChart.SeriesCollection(k + 1).Format.Line.ForeColor.RGB = lineColor(5)
ActiveChart.SeriesCollection(k + 1).Name = "=""ref."""
End If
' Set a minimum for x-axis.
If (WorksheetFunction.Min(ActiveChart.SeriesCollection(1).XValues)) < 0 Then
ActiveChart.Axes(xlCategory).MinimumScale = 0
End If
' Set minimum & maximum for x-axis.
If swDate Then
ActiveChart.Axes(xlCategory).TickLabels.NumberFormat = "mmm-yy" ' Date
Else
ActiveChart.Axes(xlCategory).TickLabels.NumberFormat = "0" ' Number
End If
' Set minimum & maximum for y-axis.
minYaxis = Sheets(listSht).Cells(j, "P")
maxYaxis = Sheets(listSht).Cells(j, "Q")
dYunit = 100
ActiveChart.Axes(xlValue).MinimumScale = minYaxis
ActiveChart.Axes(xlValue).MaximumScale = maxYaxis
ActiveChart.Axes(xlValue).MajorUnit = dYunit
ActiveChart.Axes(xlValue).TickLabels.NumberFormat = "0" ' Number
'x-axis
ActiveChart.Axes(xlCategory).HasMinorGridlines = True
ActiveChart.Axes(xlCategory).MinorGridlines.Border.LineStyle = xlDash
ActiveChart.Axes(xlCategory).MinorGridlines.Border.Color = RGB(200, 200, 200)
' Hyperlink for plot page. - chr(34) means ".
plotRow = initRowPlot + (plotPage - 1) * dyRow + 45 - 20
pageLink = "=HYPERLINK(" & Chr(34) & "#Plot_All!U" & plotRow & Chr(34) & "," & Chr(34) & "p" & plotPage & Chr(34) & ")"
Sheets(listSht).Cells(j, col4Link) = pageLink
' Verify Plot name and Target-list name.
Sheets(listSht).Cells(j, col4Name) = Sheets(dataSht).Cells(1, i)
Else
ActiveSheet.ChartObjects(objCht.Name).Delete
Sheets(listSht).Cells(j, col4Link) = ""
End If
Next
ActiveSheet.Range("B1").Select
' Update page numbers on the plots.
i = 0
For Each objShp In Worksheets(plotSht).Shapes
i = i + 1
Set pgText = ActiveSheet.Shapes(objShp.Name).GroupItems("PageNo").TextFrame2
pgText.TextRange.Characters.Text = "Page " & CStr(i) & " of " & CStr(numPages)
Set pgText = ActiveSheet.Shapes(objShp.Name).GroupItems("FigNo").TextFrame2
pgText.TextRange.Characters.Text = analysisTitle
Next
Sheets(plotSht).Select
Sheets(plotSht).Activate
' Message box
MsgBox "Done for ploting all targets! "
End Sub