The following article shows how to mark out and interrogate a calendar with the mouse. 
*In the real world, we’d open a form to read and write meaningful diary entries to a database. This exercise simply reveals the mechanics of right_clicking, and finds the details from the worksheet itself.
Before we begin, a few words of explanation about the spreadsheet, a working model of which can be found here.
The Process
Clicking on a cell within the grid will highlight that cell and change its value. Click-and-drag will highlight a range and change its values. If a cell is populated, it will be cleared, otherwise it will be populated, in this case by an “*”.
A right_click by contrast is a request for information from the selected cell.
There are essentially two events used, along with several modules.
- Worksheet_SelectionChange which is called when a cell or cells are selected.
- Worksheet_BeforeRightClick which is called by the right-hand mouse button.
The Problem
Right_clicking a cell also constitutes a selection, triggering SelectionChange. We will have to let that event run its course, clearing the cell selected before it surrenders control to the BeforeRightClick event, when we’ll repopulate the cleared cell. But this action will trigger the SelectionChanged event again, which has to be stopped from clearing it once again.
This we’ll do with a boolean flag called blnLoading.
The Events
Enter the following in the code window behind the worksheet (i.e. not in a module).
Option Explicit
Dim blnLoading As Boolean
Dim sPhase As String
Dim currCellValue As String
Dim dDate As Date
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Row > 14 And ActiveCell.Row < 25 Then
If ActiveCell.Column > 4 And ActiveCell.Column < 47 Then 'selection is valid
On Error Resume Next
currCellValue = Target.Value 'get the target value from (ByVal Target As Range)
If blnLoading = True Then 'a value of True will force an exit from this event
blnLoading = False
Exit Sub
End If
sPhase = Cells(ActiveCell.Row, 1)
If sPhase = "" Then Exit Sub
If ActiveCell = "*" Then 'if the cell is populated, clear the selected range
Call ClearRange
Call UnblockCalendar
Else
Call PopulateRange
End If
Call RedrawCells
Range("A1").Select 'revive the SelectionChange event by changing selection.
Exit Sub
End If
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If currCellValue = "*" Then 'picked up by the previous event BEFORE it cleared it;
'This means this is a valid diary entry with detail.
blnLoading = True 'this will prevent the SelectionChange event (above) from running.
Target.Select
'currCell = Target.Address
'Range(currCell).Select
Target.Value = "*" 're-instate the value of the cell, since SelectionChange has cleared it
Call PopulateRange
dDate = Cells(13, ActiveCell.Column)
sPhase = Cells(ActiveCell.Row, 1)
MsgBox dDate & " - " & sPhase
Cancel = True 'suppress Excel’s standard right_click menus
End If
Range("A1").Select
blnLoading = False
End Sub
This takes care of the two Events.
Referenced Code
Append the following, populating and depopulating ranges, to the code:
Sub ClearRange() Selection.FormulaR1C1 = "" With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With End Sub Sub PopulateRange() Selection.FormulaR1C1 = "*" With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorLight2 .TintAndShade = 0.799981688894314 .PatternTintAndShade = 0 End With End Sub
Maintenance of Gridlines
Insert a module into the application. Add the following code for maintaining the look of the grid. This was copied from the macro recorder, redundancies and all.
Option Explicit Sub UnblockCalendar() Selection.FormulaR1C1 = "" With Selection Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone End With End Sub Sub RedrawCells() Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With End Sub
Safeguarding against catastrophe
Anyone who does a lot of Excel development will know that complex xlsm spreadsheets can crash from time to time, corrupting the opened document. In more cases than might be expected, the damaged workbook can’t be recovered by Excel’s recovery routines. If there are no backups, the work done is lost. This can be prevented with tools designed to perform Excel fix.
Author Introduction:
Felix Hooker is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including rar repair and sql recovery software products. For more information visit www.datanumen.com
I am not sure where you’re getting your information, but great topic. I needs to spend some time learning more or understanding more.
Thanks for wonderful info I was looking for this information for my mission.