' ===== Global Settings =====
Public gChartType As XlChartType
Public gFilterText As String
Public gFreezeRow As Long ' Row number to freeze (0 = no freeze)
' ===== Main Macro =====
Sub AddSeriesToScatterChart()
Dim ws As Worksheet
Dim lastRow As Long, lastCol As Long, colNum As Integer
Dim chartObj As ChartObject, chartExists As Boolean
Dim ser As Series
Dim minY As Double, maxY As Double
Dim secAxisNeeded As Boolean
Dim colName As String
Dim headerCell As Range
Dim tempX() As Variant, tempY() As Variant
Dim markerX() As Variant, markerY() As Variant
Dim i As Long, j As Long, cnt As Long, markCnt As Long
Dim headerRow As Long
Dim cellVal As String
Dim rowValid As Boolean
Dim isOnOffColumn As Boolean
Dim nRows As Long
' Default settings if not set
If gChartType = 0 Then gChartType = xlXYScatterSmoothNoMarkers
If gFilterText = "" Then gFilterText = "--"
If gFreezeRow < 0 Then gFreezeRow = 0 ' safeguard
Set ws = ActiveSheet
' --- Freeze pane setting (robust) ---
On Error Resume Next
[Link]
If Not ActiveWindow Is Nothing Then
If [Link] <> xlNormalView Then [Link] = xlNormalView
End If
' ensure a cell is active so FreezePanes won't fail
[Link](1, 1).Activate
[Link] = False
If gFreezeRow > 0 Then
If gFreezeRow >= [Link] Then gFreezeRow = [Link] - 1
[Link](gFreezeRow + 1, 1).Select
[Link] = 0
[Link] = gFreezeRow
[Link] = True
End If
On Error GoTo 0
' --- End freeze block ---
' Ask user to CLICK on the header cell
On Error Resume Next
Set headerCell = [Link]("Click on the column header cell:", Type:=8)
On Error GoTo 0
If headerCell Is Nothing Then Exit Sub
colNum = [Link]
colName = Trim(CStr([Link]))
headerRow = [Link]
' Find last row and last column
lastRow = [Link]([Link], colNum).End(xlUp).Row
lastCol = [Link](headerRow, [Link]).End(xlToLeft).Column
If lastCol < 1 Then lastCol = 1
' Compute a safe size for initial ReDim (avoid 1 To 0)
nRows = lastRow - headerRow
If nRows < 1 Then nRows = 1
' Detect if this is an ON/OFF column (case-insensitive, allows empty cells)
isOnOffColumn = True
For i = headerRow + 1 To lastRow
cellVal = Trim(UCase(CStr([Link](i, colNum).Value)))
If cellVal <> "" And cellVal <> "ON" And cellVal <> "OFF" Then
isOnOffColumn = False
Exit For
End If
Next i
' Build arrays (safe initial sizes)
ReDim tempX(1 To nRows)
ReDim tempY(1 To nRows)
ReDim markerX(1 To nRows)
ReDim markerY(1 To nRows)
cnt = 0: markCnt = 0
For i = headerRow + 1 To lastRow
rowValid = True
' Check every column in this row for invalid markers
For j = 1 To lastCol
cellVal = Trim(CStr([Link](i, j).Value))
If cellVal = "" _
Or (gFilterText <> "" And cellVal = gFilterText) _
Or (Len(cellVal) > 0 And cellVal = String(Len(cellVal), "-")) Then
rowValid = False
Exit For
End If
Next j
If rowValid Then
cnt = cnt + 1
tempX(cnt) = cnt
tempY(cnt) = [Link](i, colNum).Value
If isOnOffColumn Then
If UCase(Trim(CStr([Link](i, colNum).Value))) = "ON" Then
markCnt = markCnt + 1
markerX(markCnt) = cnt
markerY(markCnt) = 1 ' you can change this to overlay on another series if desired
End If
End If
End If
Next i
' If no valid data
If cnt = 0 Then
MsgBox "No valid data found under " & colName
Exit Sub
End If
' Resize the main arrays to actual data count
ReDim Preserve tempX(1 To cnt)
ReDim Preserve tempY(1 To cnt)
' Only shrink marker arrays if markCnt > 0 (prevents ReDim Preserve error)
If markCnt > 0 Then
ReDim Preserve markerX(1 To markCnt)
ReDim Preserve markerY(1 To markCnt)
End If
' Check if chart exists (look for MyScatterChart)
chartExists = False
For Each chartObj In [Link]
If [Link] = "MyScatterChart" Then
chartExists = True
Exit For
End If
Next chartObj
If Not chartExists Then
' Create new chart
Set chartObj = [Link](Left:=300, Top:=50, Width:=500, Height:=300)
[Link] = "MyScatterChart"
[Link] = gChartType
[Link] = True
[Link] = "Chart"
Else
' reuse existing
Set chartObj = [Link]("MyScatterChart")
[Link] = gChartType
End If
' Add main series
Set ser = [Link]
[Link] = tempX
[Link] = tempY
[Link] = colName
' If On/Off markers exist, add them (only when markCnt > 0)
If isOnOffColumn And markCnt > 0 Then
Dim markSeries As Series
Set markSeries = [Link]
[Link] = markerX
[Link] = markerY
[Link] = colName & " (On)"
[Link] = xlXYScatter
[Link] = xlMarkerStyleCircle
[Link] = 8
[Link] = msoFalse
' Optional: color the marker series (uses automatic coloring by default)
On Error Resume Next
[Link] = RGB(255, 0, 0)
[Link] = RGB(255, 0, 0)
On Error GoTo 0
End If
' Check if secondary axis is needed (compare with first series)
secAxisNeeded = False
If [Link] > 1 Then
On Error Resume Next
minY = [Link]([Link](1).Values)
maxY = [Link]([Link](1).Values)
If [Link] = 0 Then
If Abs([Link](tempY) - minY) > 150 Or _
Abs([Link](tempY) - maxY) > 150 Then
secAxisNeeded = True
End If
End If
On Error GoTo 0
End If
If secAxisNeeded Then
[Link] = xlSecondary
[Link] = "Chart (with Secondary Axis)"
End If
End Sub
' ===== Settings Macro =====
Sub SetChartPreferences()
Dim choice As Variant
Dim filterInput As String
Dim freezeInput As Variant
' Ask for chart type
choice = [Link]( _
"Select chart type:" & vbCrLf & _
"1 - Scatter Smooth (Default)" & vbCrLf & _
"2 - Line Chart" & vbCrLf & _
"3 - Column Chart" & vbCrLf & _
"4 - Pie Chart", "Chart Type", Type:=1)
If choice = False Then Exit Sub
Select Case choice
Case 1: gChartType = xlXYScatterSmoothNoMarkers
Case 2: gChartType = xlLine
Case 3: gChartType = xlColumnClustered
Case 4: gChartType = xlPie
Case Else
MsgBox "Invalid choice. Keeping previous setting."
End Select
' Ask for filter text
filterInput = InputBox("Enter a value to filter out (e.g., -- , NA , etc.):", "Filter Value", gFilterText)
If filterInput <> "" Then gFilterText = filterInput
' Ask for row to freeze
freezeInput = [Link]("Enter the row number to freeze (0 = no freeze, 1 = top row):",
_
"Freeze Row", gFreezeRow, Type:=1)
If freezeInput <> False Then
If freezeInput < 0 Then
MsgBox "Row number cannot be negative. Setting to 0 (no freeze)."
gFreezeRow = 0
Else
gFreezeRow = CLng(freezeInput)
End If
End If
MsgBox "Preferences saved!" & vbCrLf & _
"Default Chart: " & choice & vbCrLf & _
"Filter: " & gFilterText & vbCrLf & _
"Freeze Row: " & gFreezeRow
End Sub