Select cells in MS excel 2007 by double click
I want the user to be able to just select one cell in each row
This code is highlighting cells in excel 2007, but my problem is that I cannot write code that restricts the user to select only one cell in a row,
here is the code:
Private Sub Worksheet_BeforeDoubleClick( _
ByVal Target As Range, Cancel As Boolean)
' This macro is activated when you doubleclick
' on a cell on a worksheet.
' Purpose: color or decolor the cell when clicked on again
' by default color number 3 is red
If Target.Interior.ColorIndex = 3 Then
' if cell is already red, remove the color:
Target.Interior.ColorIndex = 2
Else
' make the cell red:
Target.Interior.ColorIndex = 3
End If
' true to cancel the 'editing' mode of a cell:
Cancel = True
End Sub
source to share
Instead of storing the selected cell references in a separate or hidden sheet, the selected cell references can be stored in memory. They just need to be initialized after the sheet is loaded (using a method Worksheet_Activate()
), but otherwise it will work in a similar way.
Add the following code to the appropriate sheet in the workbook:
' Set of highlighted cells indexed by row number
Dim highlightedCells As New Collection
' Scan existing sheet for any cells coloured 'red' and initialise the
' run-time collection of 'highlighted' cells.
Private Sub Worksheet_Activate()
Dim existingHighlights As Range
' Reset the collection of highlighted cells ready to rebuild it
Set highlightedCells = New Collection
' Find the first cell that has its background coloured red
Application.FindFormat.Interior.ColorIndex = 3
Set existingHighlights = ActiveSheet.Cells.Find("", _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True)
' Process for as long as we have more matches
Do While Not existingHighlights Is Nothing
cRow = existingHighlights.Row
' Add a reference only to the first coloured cell if multiple
' exist in a single row (will only occur if background manually set)
Err.Clear
On Error Resume Next
Call highlightedCells.Add(existingHighlights.Address, CStr(cRow))
On Error GoTo 0
' Search from the cell after the last match. Note an error in Excel
' appears to prevent the FindNext method from finding formats correctly
Application.FindFormat.Interior.ColorIndex = 3
Set existingHighlights = ActiveSheet.Cells.Find("", _
After:=existingHighlights, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=True)
' Abort the search if we've looped back to the top of the sheet
If (existingHighlights.Row < cRow) Then
Exit Do
End If
Loop
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim hCell As String
Dim cellAlreadyHighlighted As Boolean
hCell = ""
Err.Clear
On Error Resume Next
hCell = highlightedCells.Item(CStr(Target.Row))
On Error GoTo 0
If (hCell <> "") Then
ActiveSheet.Range(hCell).Interior.ColorIndex = 0
If (hCell = Target.Address) Then
Call highlightedCells.Remove(CStr(Target.Row))
Target.Interior.ColorIndex = 0
Else
Call highlightedCells.Remove(CStr(Target.Row))
Call highlightedCells.Add(Target.Address, CStr(Target.Row))
Target.Interior.ColorIndex = 3
End If
Else
Err.Clear
On Error Resume Next
highlightedCells.Remove (CStr(Target.Row))
On Error GoTo 0
Call highlightedCells.Add(Target.Address, CStr(Target.Row))
Target.Interior.ColorIndex = 3
End If
Cancel = True
End Sub
source to share
I believe you want to reset the cell color to a normal cell, not specifically fill it with a white background.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Dim iCOLOR As Long
If Target.Interior.ColorIndex <> 3 Then _
iCOLOR = 3
Rows(Target.Row).Interior.Pattern = xlNone
If iCOLOR = 3 Then _
Target.Interior.ColorIndex = iCOLOR
End Sub
The fill removal method is set .Interior.Pattern = xlNone
.
If you need a solid fill of a white cell, if it is not red, then it can be turned on and off.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Dim iCOLOR As Long
iCOLOR = 3 + CBool(Target.Interior.ColorIndex = 3)
Rows(Target.Row).Cells.Interior.ColorIndex = 2
Target.Interior.ColorIndex = iCOLOR
End Sub
Of course, ListObject presents a different set of problems.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, ListObjects("Table1").DataBodyRange) Is Nothing Then
Cancel = True
Dim iCOLOR As Long
iCOLOR = 3 + CBool(Target.Interior.ColorIndex = 3)
Intersect(Rows(Target.Row), ListObjects("Table1").DataBodyRange).Interior.ColorIndex = 2
Target.Interior.ColorIndex = iCOLOR
End If
End Sub
source to share
Suggest using a method Worksheet_BeforeDoubleClick
to keep track of a selected cell by placing a double reference to a hidden sheet, then either use conditional formatting or explicit checks in an event handler to highlight the corresponding cell (or "cells" if you allow one cell to be selected on multiple rows) based on the value (s) in a hidden sheet. If you choose to use conditional formatting, whenever a new cell is "double-clicked", the link is updated in the hidden sheet and the conditional formatting is automatically recalculated. Only one cell in a given row will ever be "selected".
Alternatively, you can do this explicitly by adjusting the double-click event handling code to match the following lines:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If (Not (IsEmpty(Worksheets("Sheet2").Cells(1, 1).Value))) Then
ActiveSheet.Range(Worksheets("Sheet2").Cells(1, 1).Value).Interior.ColorIndex = 0
End If
Worksheets("Sheet2").Cells(1, 1).Value = Target.Address
ActiveSheet.Range(Worksheets("Sheet2").Cells(1, 1).Value).Interior.ColorIndex = 3
End Sub
This way you can also check all selected cell (s) when the sheet is loaded and reset them if needed (assuming the user is allowed to save changes).
To select only one cell in any given row (but allowing multiple rows to have one selected cell), you can use the following (this also toggles the selection in an already selected cell):
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If (Not (IsEmpty(Worksheets("Sheet2").Cells(Target.Row, 1).Value))) Then
ActiveSheet.Range(Worksheets("Sheet2").Cells(Target.Row, 1).Value).Interior.ColorIndex = 0
If (Worksheets("Sheet2").Cells(Target.Row, 1).Value = Target.Address) Then
Worksheets("Sheet2").Cells(Target.Row, 1).Value = ""
Target.Interior.ColorIndex = 0
Else
Worksheets("Sheet2").Cells(Target.Row, 1).Value = Target.Address
Target.Interior.ColorIndex = 3
End If
Else
Worksheets("Sheet2").Cells(Target.Row, 1).Value = Target.Address
Target.Interior.ColorIndex = 3
End If
Cancel = True
End Sub
source to share
Try the following:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Target must be between column "A" which is 1 & "G" which is 7 and also between row 1 and 10.
'I also add checking for row. If you don't need, remove it.
If Target.Column >= 1 And Target.Column <= 7 And Target.row >= 1 And Target.row <= 10 Then
If Target.Interior.ColorIndex = 3 Then
' if cell is already red, remove the color:
Target.Interior.ColorIndex = 2
Else
' make the cell red:
Target.Interior.ColorIndex = 3
End If
' true to cancel the 'editing' mode of a cell:
Cancel = True
End If
End Sub
source to share