Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 369
  • Last Modified:

Macro fix for Check Mark

EE Pros,

I have a slight problem with a Macro that I have where some change I have made has caused it to issue a "Type Mismatch" error.  I have attached the file....please take a look.  When you double click one of the black boxes, you automatically get a "check mark" that fills the box.  That is presently where I'm receiving the error.  It's minor; but I don't know how to troubleshoot it.

Thank you in advance,

B.
Error-in-Macro-on-Check-Box.xlsm
0
Bright01
Asked:
Bright01
2 Solutions
 
FlysterCommented:
You get a type mismatch error because the routine "Private Sub Worksheet_BeforeDoubleClick" makes the value of the target cell "=Value". So when your code gets to this line, "Total = Total + .Offset(0, 5).Value", it is trying to add text to text. The simple solution is to rem out that line. (Place a single quote in front of the line of code.) I wasn't able to figure out what number or formula the code was trying to produce.

Flyster
0
 
byundtCommented:
I modified your Worksheet_BeforeDoubleClick sub using structured indenting (so I could follow the logic). I also used an ElseIf to eliminate the need for one If block. And I turned off events to avoid triggering the Worksheet_Change event sub when cell values were cleared or set.

You should note the statement where I commented "Value is not a defined name". This causes a #REF! error value to be placed in column J, which in turn caused the run-time error Type Mismatch that you were complaining about (in the sumup sub). Flyster also pointed out this same statement.

Please discuss how you want to handle the formula in column J, as I just put something in there to avoid the error.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Column = 5 Then

    Application.EnableEvents = False
    With ActiveCell
        If .Value = "P" Then
            .Value = ""
            .Offset(0, 5).ClearContents
        ElseIf .Offset(0, 1).Value <> "" Then
            .Font.Name = "Wingdings 2"
            .Value = "P"
            .Offset(0, 5).FormulaR1C1 = ""            '"=Value"    'Value is not a defined name
        End If
    
    End With
    'These two lines below make it a realtime update vs. using a button and the sub "sumup"
    Cancel = True
    Application.EnableEvents = True
    
    sumup
End If
End Sub

Open in new window

I also modified the sumup sub by using structured indenting so I could follow the logic, and by adding a test for an error value in the statement that caused the run-time error
Total = Total + .Offset(0, 5).Value
Sub sumup()
Const Input_Range = 9
Const Output_Range = 3
Const Output_CS = 17
Const Output_CE = 18
Const Input_CM = 5

Dim O_R As Long
'Output Row
Dim I_R As Long
'Input Row
Dim Total As Double

'Total

'**** Clear the previous output ****
O_R = Cells(Rows.Count, Output_CS).End(xlUp).Row
If O_R >= Output_Range Then
    'Column and Row Output
    Range(Cells(Output_Range, Output_CS), Cells(O_R, Output_CE)).ClearContents
End If
'Column Explanation
O_R = Output_Range


'Where the checkmark is
I_R = Cells(Rows.Count, Input_CM).End(xlUp).Row
If I_R >= Input_Range Then
    'Input row
    For I = Input_Range To I_R
        With Cells(I, Input_CM)
            If .Value = "P" Then
                'Output results here
                Cells(O_R, Output_CS).Value = .Offset(0, 1).Value
                Cells(O_R, Output_CE).Formula = "=" & .Offset(0, 5).Address
                Cells(O_R, Output_CE).NumberFormatLocal = _
                        "_(""$""* #,##0_);_(""$""* (#,##0);_(""$""* ""-""??_);_(@_)"
                
                If Not IsError(.Offset(0, 5).Value) Then Total = Total + .Offset(0, 5).Value
                O_R = O_R + 1
            End If
        End With
    Next
    Cells(Output_Range - 1, Output_CS).Value = "Total"
    With Cells(Output_Range - 1, Output_CE)
        .FormulaR1C1 = "=SUM(R[1]C:R[" & O_R & "]C)"
        .NumberFormatLocal = _
                "_(""$""* #,##0_);_(""$""* (#,##0);_(""$""* ""-""??_);_(@_)"
    End With
    'Else
    
    'MsgBox "Please select what you wanted! Thanks!"
End If

End Sub

Open in new window

0
 
Bright01Author Commented:
Thanks guys!  The code that byundt provided fixed the issue.  I'm integrating it now.  The issue with the other cells is work in process and I've got to get further down the path before matching up the values that emerge in the model.  

Fixing one challenge at a time makes for good Excel education and training!

Thanks for the Teamwork on this one.

B.
0

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now