Fidgety VB Code

TesseractE

New Member
Joined
Nov 30, 2011
Messages
38
I'm trying to put together a method for letting people tally up short, medium and long calls and to document the date along with those tallies. So far, I've got some code that will change the background color and leave the current date if the cell is double-clicked.

The first double-click turns it green to signify a short call, Another double-click shows yellow for a medium length call, another shows red for a long call, then a fourth will clear the cell.

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
      If Target.Interior.ColorIndex = 3 Then
        Target.Interior.ColorIndex = xlNone
        Target.Cells.Clear
      Else
        If Target.Interior.ColorIndex = 6 Then
          Target.Interior.ColorIndex = 3
          Target.Cells.Value = Format(Date, "mmm dd")
          Else
            If Target.Interior.ColorIndex = 4 Then
                Target.Interior.ColorIndex = 6
                Target.Cells.Value = Format(Date, "mmm dd")
                Else
                    If Target.Interior.ColorIndex = xlNone Then
                    Target.Interior.ColorIndex = 4
                    Target.Cells.Value = Format(Date, "mmm dd")
                    End If
            End If
        End If
      End If
      Cancel = True
End Sub

To go along with this, I have a UDF to count the number of times each color shows up.

Code:
Function COUNTCOLOR(R As Range, C As Integer)

    Dim cell As Object
    Dim N As Integer

    For Each cell In R
        If cell.Interior.ColorIndex = C Then
            N = N + 1
        End If
    Next
    COUNTCOLOR = N
End Function

It all seems to work just fine...
Working+%28Pass+Count%29.png


...but if one of the cells cycles back to blank, I get #VALUE! errors from the COUNTCOLOR function.
Broken+%28Pass+Count%29.png


Refreshing the function by editing, then hitting enter (or Tab) will bring up the correct value again.
Working2+%28Pass+Count%29.png


Any suggestions on how to patch this up to be a little more reliable?
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Code:
Function COUNTCOLOR(R As Range, C As Integer)
    Dim cell As Range
    Dim N As Integer
    For Each cell In R
        If cell.Interior.ColorIndex = C Then
            N = N + 1
           [COLOR=#ff0000] if N >56 then N=0[/COLOR]
        End If
    Next
    COUNTCOLOR = N
End Function
 
Upvote 0
Thanks for your reply, but that didn't appear to work. I still get the #VALUE! error.

If anyone can tell me WHY I'm getting this error, I'd be grateful as well, and it might help me find my own solution.
 
Last edited:
Upvote 0
Not sure of the why...

But in the part of the event code that sets the colorindex to xlnone
It then does Target.Cells.Clear

This is the cause (again, not sure why)

But removing that line resolves the issue.

I think you can just change that line to
Target.Cells.Value = ""

or add this at the end

Target.Calculate
 
Upvote 0
I was starting to wonder if that method of clearing the cell might have been the culprit. I changed it to the ' Target.Cells.Value = "" ' and now it's behaving. Thanks, jonmo!

One more spot of help if I may... I'd like to only have this double-click action confined to specific columns, and not the entire sheet. How would I achieve that?
 
Upvote 0
Glad to help, thanks for the feedback.

To restrict the area of the sheet the code works on, use Intersect.

If Intersect(Target, Range("A:E")) Is Nothing Then Exit Sub
 
Upvote 0
Fantastic! VB is very much not my forte, but it was the only solution for this particular project.

Thanks again for helping me learn!
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,172
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top