I need to be able to click on a cell to bold/unbold the number in the cell

I have a monthly vehicle report that I am revamping and I need to build some features into it to increase user friendlieness. I need to be able to click on a cell that has a day of the month in it, to bold or unbold and count/uncount the number of bold days. For example the days of the month will be in cells B6:I9 and the tally box at J7.

Maybe:

Bold and Count

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long
Dim rcell As Range
x = 0
If Not Intersect(Target, Range("B6:I9")) Is Nothing Then
    Target.Font.Bold = True
    For Each rcell In Range("B6:I9")
        If rcell.Font.Bold = True Then x = x + 1
    Next rcell
    Range("J7").Value = x
End If
End Sub

Clear Bold and Count

Sub giligancow()
Range("B6:I9").Font.Bold = False
Range("J7").Value = ""
End Sub

Can i make it bold with one click and unbold with one click, as well as add and subtract per click? As it is a double click on a cell then a click off the cell creates the bold and the number count in the tally box. It doesn't unbold with a click or subtract when bold is turned off. Thanks for helping

If you already have the tally in J7 working with the bold/unbold count, wouldn't it be more efficient to train the people to use Cntrl+B to bold the cell and Cntrl+Z to reverse that action? That way, they can spend less time moving a mouse and more time on the keyboard, which would be faster as well as teach them something.

Or they can use the "B" icon on the ribbon. But that reequires moving the mouse.

I am just trying to create the product that my bosses want. Maybe a way to click to highlight cells with fill color is a better way to do it. I already have a macro that counts highlighted cells. My boss wants a quick easy way to highlight the cells to show the days a given vehicle is used within the month when the report is printed.

Try putting this code in the Worksheet Module.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    'If the target cell is clear
    If Target.Interior.ColorIndex = xlNone Then

        'Then change the background to the specified color
        Target.Interior.ColorIndex = 4

        'But if the target cell is already the specified color
        ElseIf Target.Interior.ColorIndex = 4 Then

        'Then clear the background color
        Target.Interior.ColorIndex = xlNone

    End If
End Sub

I think this may be what you need.

That is nearly perfect. I need the "double click to bold" to be restricted to the B6:I9 range. I also need to add in auto capitolization for ranges (A28:K42) and (J12:J21). I put in:

[B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range

If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
Application.EnableEvents = False

Set rng = Union([B1], [A28:K42,J12:J21], [G:G]) 'Upper Case
If Not Intersect(Target, rng) Is Nothing Then
Target = UCase(Target)
End If

Application.EnableEvents = True
End Sub
but I get a compile error: Ambiguous name detected. It works on other worksheets that don't have the code you provided. Thanks again for the help!

Untested, but try this;

  For Each xCell In (Target, Range("A28:K42" & "J12:J21")) 
  If UCase(xCell.Text) <> xCell.Text Then xCell.Value = UCase(xCell.Text)
Next
' Not sure if these two lines would be needed. But if so, then set the reverse action before this part of code runs.
' Application.Calculation = xlAutomatic
' Application.ScreenUpdating = True
 End Sub

Jim885, I'm sorry but I'm not sure how to use the code that you provided. Below is what I have so far...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
   'If the target cell is not bold
   If Target.Font.Bold = False Then

      'Then change the font to bold
      Target.Font.Bold = True

      'But if the target cell is already bold
   ElseIf Target.Font.Bold = True Then

      'Then change the font to not bold
      Target.Font.Bold = False

   End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long
Dim rcell As Range
If Not Intersect(Target, Range("B7:I10")) Is Nothing Then
For Each rcell In Range("B7:I10")
        If rcell.Font.Bold = True Then x = x + 1
    Next rcell
    Range("J7").Value = x
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range

If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
Application.EnableEvents = False

Set rng = Union([B1], [A27:K37,J11:J21], [G:G]) 'Upper Case
If Not Intersect(Target, rng) Is Nothing Then
Target = UCase(Target)
End If

Application.EnableEvents = True
End Sub

Thanks again for helping out a beginner!

I got the bold / Unbold to only work in the B6:I9 range...

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

If Not Intersect(Target, Range("B6:I9")) Is Nothing Then  'added this line
   
   'If the target cell is not bold
   If Target.Font.Bold = False Then

      'Then change the font to bold
      Target.Font.Bold = True

      'But if the target cell is already bold
   ElseIf Target.Font.Bold = True Then

      'Then change the font to not bold
      Target.Font.Bold = False

   End If  ' added this line
   End If

End Sub

Hope this helps

Thank you so much moonsaga! I had tried something similar but didn't have the second "End If". I still can't get the auto upper case to work. It works flawlessly if I don't have the code for the "double click to bold" in there but as soon as I put it in the auto caps doesn't work. The code I have for that is above.

I copied your code to my test workbook and It works for me with the rest of the code.. I don't know why it doesn't work for you..

Thanks xlbiznes but I need a different range to be auto upper case. I have a workbook with only this code and it works great:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range

If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
Application.EnableEvents = False

Set rng = Union([B1], [A28:K42,J12:J22], [G:G]) 'Upper Case
If Not Intersect(Target, rng) Is Nothing Then
Target = UCase(Target)
End If

Application.EnableEvents = True
End Sub

I also have a workbook with code to bold/unbold a range of 31 numbers that represent a month. It also counts the number of bold numbers and tallies them in a separate cell. The part of the code that runs the bold and count works great but the auto upper case doesn't work in this workbook and is as follows:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, Range("B7:I10")) Is Nothing Then
  
   'If the target cell is not bold
   If Target.Font.Bold = False Then

      'Then change the font to bold
      Target.Font.Bold = True

      'But if the target cell is already bold
   ElseIf Target.Font.Bold = True Then

      'Then change the font to not bold
      Target.Font.Bold = False
   End If
   End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long
Dim rcell As Range
If Not Intersect(Target, Range("B7:I10")) Is Nothing Then
For Each rcell In Range("B7:I10")
        If rcell.Font.Bold = True Then x = x + 1
    Next rcell
    Range("J7").Value = x
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range

If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
Application.EnableEvents = False

Set rng = Union([B1], [A28:K42,J12:J22], [G:G]) 'Upper Case
If Not Intersect(Target, rng) Is Nothing Then
Target = UCase(Target)
End If

Application.EnableEvents = True
End Sub

Again, thanks for the help