SanDana

03-21-2009, 09:18 AM

I'm new to VBA so any help would be greatly appreciated...

I'm using code found on this site for adding a checkmark to a cell when the cell is double-clicked. It works great for one range of cells but how do I get it to work for multiple ranges?

My spreadsheet looks like this:

Range A10:A20 named SLCkBoxes- Cells to double click for checkmark

Range B10:B20 - List of Departments

Range C10:C30 named PosCkBoxes1 - Cells to double click for checkmark

Range D10:20 - List of Job Titles

Range E10:E20 named PosCkBoxes2 - Cells to double click for checkmark

Range F:10:F20 - Continued list of Job Titles

If put all of this in one column it would be too long...

Here's the code I'm using which works for the named range SLCkBoxes. How do I get this to work for the other ranges as well?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'Limit Target count to 1

If Target.Count > 1 Then Exit Sub

'Isolate Target to a specific range

If Intersect(Target, Range("SLCkBoxes")) Is Nothing Then Exit Sub

'Set Target font to "marlett"

Target.Font.Name = "marlett"

'Check value of target

If Target.Value <> "a" Then

Target.Value = "a" 'Sets target Value = "a"

Cancel = True

Exit Sub

End If

If Target.Value = "a" Then

Target.ClearContents 'Sets target Value = ""

Cancel = True

Exit Sub

End If

End Sub

I'm using code found on this site for adding a checkmark to a cell when the cell is double-clicked. It works great for one range of cells but how do I get it to work for multiple ranges?

My spreadsheet looks like this:

Range A10:A20 named SLCkBoxes- Cells to double click for checkmark

Range B10:B20 - List of Departments

Range C10:C30 named PosCkBoxes1 - Cells to double click for checkmark

Range D10:20 - List of Job Titles

Range E10:E20 named PosCkBoxes2 - Cells to double click for checkmark

Range F:10:F20 - Continued list of Job Titles

If put all of this in one column it would be too long...

Here's the code I'm using which works for the named range SLCkBoxes. How do I get this to work for the other ranges as well?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'Limit Target count to 1

If Target.Count > 1 Then Exit Sub

'Isolate Target to a specific range

If Intersect(Target, Range("SLCkBoxes")) Is Nothing Then Exit Sub

'Set Target font to "marlett"

Target.Font.Name = "marlett"

'Check value of target

If Target.Value <> "a" Then

Target.Value = "a" 'Sets target Value = "a"

Cancel = True

Exit Sub

End If

If Target.Value = "a" Then

Target.ClearContents 'Sets target Value = ""

Cancel = True

Exit Sub

End If

End Sub