How can I make merged Excel cells cycle symbols on click and update a helper cell using VBA?
I am building an Excel character sheet where certain cells act as clickable proficiency indicators.
Each indicator cell (often merged across multiple columns/rows for layout) should cycle through symbols when clicked:
○ → ● → ■ → ○ (repeat)
When the symbol changes, a numeric value should be written to the cell immediately to the right of the merged area so formulas can calculate skill bonuses.
I am using Worksheet_SelectionChange in the worksheet module. The code runs, but I intermittently get “Application-defined or object-defined error”, usually when clicking merged cells.
I have confirmed:
- Macros are enabled
- The code is in the correct worksheet module
- The event fires in simple tests
My difficulty is safely determining the cell to the right of a merged range and writing to it without errors.
Question: What is the safest pattern for handling merged cells in Worksheet_SelectionChange when writing to adjacent cells?
This is the code I have right now.
Option Explicit ' Place this code in the specific worksheet module (e.g., Sheet1), ' not in a standard Module. ' Comma-separated list of ranges that should respond to toggles. ' Example: "B6:B40,D6:D40". Leave blank to allow any cell in UsedRange. Private Const SYMBOL_TARGET_RANGES As String = "" Private Const SYMBOL_STATES As String = "??¦" Private Sub Worksheet_SelectionChange(ByVal Target As Range) HandleSymbolToggle Target End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If HandleSymbolToggle(Target) Then Cancel = True End Sub Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) If HandleSymbolToggle(Target) Then Cancel = True End Sub Private Function HandleSymbolToggle(ByVal Target As Range) As Boolean On Error GoTo CleanFail Static isBusy As Boolean If isBusy Then Exit Function Dim c As Range Set c = ResolveSymbolCell(Target) If c Is Nothing Then Exit Function If Not IsInToggleRange(c) Then Exit Function Dim symbol As String symbol = NormalizeSymbol(c.Value2) If symbol = vbNullString Then Exit Function Dim nextSymbol As String nextSymbol = GetNextState(symbol) Dim multiplier As Long multiplier = GetStateIndex(nextSymbol) - 1 isBusy = True Application.EnableEvents = False c.Value2 = nextSymbol Me.Cells(c.Row, "ZZ").Value2 = multiplier HandleSymbolToggle = True CleanExit: Application.EnableEvents = True isBusy = False Exit Function CleanFail: Resume CleanExit End Function Private Function ResolveSymbolCell(ByVal Target As Range) As Range If Target Is Nothing Then Exit Function If Target.CountLarge > 1 And Not Target.MergeCells Then Exit Function If Target.MergeCells Then Set ResolveSymbolCell = Target.MergeArea.Cells(1, 1) Else Set ResolveSymbolCell = Target.Cells(1, 1) End If End Function Private Function IsInToggleRange(ByVal c As Range) As Boolean Dim allowed As Range Set allowed = GetAllowedToggleRange() If allowed Is Nothing Then Exit Function IsInToggleRange = Not Application.Intersect(c, allowed) Is Nothing End Function Private Function GetAllowedToggleRange() As Range On Error GoTo BadRange If Len(Trim$(SYMBOL_TARGET_RANGES)) = 0 Then Set GetAllowedToggleRange = Me.UsedRange Else Set GetAllowedToggleRange = Me.Range(SYMBOL_TARGET_RANGES) End If Exit Function BadRange: Set GetAllowedToggleRange = Nothing End Function Private Function NormalizeSymbol(ByVal rawValue As Variant) As String Dim txt As String txt = Trim$(CStr(rawValue)) If GetStateIndex(txt) > 0 Then NormalizeSymbol = txt End If End Function Private Function GetNextState(ByVal currentState As String) As String Dim idx As Long idx = GetStateIndex(currentState) If idx = 0 Then Exit Function idx = idx + 1 If idx > Len(SYMBOL_STATES) Then idx = 1 GetNextState = Mid$(SYMBOL_STATES, idx, 1) End Function Private Function GetStateIndex(ByVal symbol As String) As Long GetStateIndex = InStr(1, SYMBOL_STATES, symbol, vbBinaryCompare) End Function Thanks for y'all's time.
[link] [comments]
Want to read more?
Check out the full article on the original site