We help IT Professionals succeed at work.

Run-Time error "13" type mismatch - problem with code and txt/number

jamiepryer
jamiepryer asked
on
582 Views
Last Modified: 2012-05-05
Hi,
im using the following code i found on the web and it all works fine when im converting numbers.
However when i try and use this against some txt, it falls over?
any suggestions on what needs to be changed?

nb. this code is for changing conditional formatting to its "real" value.
Option Explicit
Sub PasteFC()
    
    Dim rWhole As Range
    Dim rCell As Range
    Dim ndx As Integer
    Dim FCFont As Font
    Dim FCBorder As Border
    Dim FCInt As Interior
    Dim x As Integer
'    Dim iBorders(3) As Integer
'
'    iBorders(0) = xlLeft
'    iBorders(1) = xlRight
'    iBorders(2) = xlTop
'    iBorders(3) = xlBottom
    
    GetRange2
    Application.ScreenUpdating = False
    Set rWhole = Selection
 
    For Each rCell In rWhole
        rCell.Select
        ndx = ActiveCondition(rCell)
        If ndx <> 0 Then
            'Change the Font info
            Set FCFont = rCell.FormatConditions(ndx).Font
            With rCell.Font
                .Bold = NewFC(.Bold, FCFont.Bold)
                .Italic = NewFC(.Italic, FCFont.Italic)
                .Underline = NewFC(.Underline, FCFont.Underline)
                .Strikethrough = NewFC(.Strikethrough, _
                  FCFont.Strikethrough)
                .ColorIndex = NewFC(.ColorIndex, FCFont.ColorIndex)
            End With
            'Change the Border Info for each of the 4 types
'            For x = 0 To 3
'                Set FCBorder = rCell.FormatConditions(ndx).Borders(iBorders(x))
'                With rCell.Borders(iBorders(x))
'                    .LineStyle = NewFC(.LineStyle, FCBorder.LineStyle)
'                    .Weight = NewFC(.Weight, FCBorder.Weight)
'                    .ColorIndex = NewFC(.ColorIndex, FCBorder.ColorIndex)
'                End With
'            Next x
            'Change the interior info
            Set FCInt = rCell.FormatConditions(ndx).Interior
            With rCell.Interior
                .ColorIndex = NewFC(.ColorIndex, FCInt.ColorIndex)
                .Pattern = NewFC(.Pattern, FCInt.Pattern)
            End With
            'Delete FC
            rCell.FormatConditions.Delete
        End If
    Next
    rWhole.Select
    Application.ScreenUpdating = True
    MsgBox ("The Formatting based on the Conditions" & vbCrLf & _
      "in the range " & rWhole.Address & vbCrLf & _
      "has been made standard for those cells" & vbCrLf & _
      "and the Conditional Formatting has been removed")
End Sub
Function NewFC(vCurrent As Variant, vNew As Variant)
    If IsNull(vNew) Then
        NewFC = vCurrent
    Else
        NewFC = vNew
    End If
End Function
Function ActiveCondition(rng As Range) As Integer
    'Chip Pearson http://www.cpearson.com/excel/CFColors.htm
    Dim ndx As Long
    Dim FC As FormatCondition
 
    If rng.FormatConditions.Count = 0 Then
        ActiveCondition = 0
    Else
    For ndx = 1 To rng.FormatConditions.Count
        Set FC = rng.FormatConditions(ndx)
        Select Case FC.Type
            Case xlCellValue
                Select Case FC.Operator
                    Case xlBetween
                        If CDbl(rng.Value) >= CDbl(FC.Formula1) And _
                          CDbl(rng.Value) <= CDbl(FC.Formula2) Then
                            ActiveCondition = ndx
                            Exit Function
                        End If
                    Case xlGreater
                        If CDbl(rng.Value) > CDbl(FC.Formula1) Then
                            ActiveCondition = ndx
                            Exit Function
                        End If
                    Case xlEqual
                        If CDbl(rng.Value) = CDbl(FC.Formula1) Then
                            ActiveCondition = ndx
                            Exit Function
                        End If
                    Case xlGreaterEqual
                        If CDbl(rng.Value) >= CDbl(FC.Formula1) Then
                            ActiveCondition = ndx
                            Exit Function
                        End If
                    Case xlLess
                        If CDbl(rng.Value) < CDbl(FC.Formula1) Then
                            ActiveCondition = ndx
                            Exit Function
                        End If
                    Case xlLessEqual
                        If CDbl(rng.Value) <= CDbl(FC.Formula1) Then
                            ActiveCondition = ndx
                            Exit Function
                        End If
                    Case xlNotEqual
                        If CDbl(rng.Value) <> CDbl(FC.Formula1) Then
                            ActiveCondition = ndx
                            Exit Function
                        End If
                    Case xlNotBetween
                        If CDbl(rng.Value) <= CDbl(FC.Formula1) Or _
                            CDbl(rng.Value) >= CDbl(FC.Formula2) Then
                            ActiveCondition = ndx
                            Exit Function
                        End If
                    Case Else
                        Debug.Print "UNKNOWN OPERATOR"
                End Select
            Case xlExpression
                If Application.Evaluate(FC.Formula1) Then
                    ActiveCondition = ndx
                    Exit Function
                End If
            Case Else
                Debug.Print "UNKNOWN TYPE"
        End Select
    Next ndx
    End If
    ActiveCondition = 0
End Function
 
Private Sub GetRange2()
'gets the range you want to highlight and sets it to be called "data"
'this is essential for your conditional formatting rule
    Dim rng As Range
    On Error Resume Next
    ActiveSheet.Select
    Set rng = Application.InputBox(prompt:="Please select the cells that you want to convert the conditional formatting on", Type:=8)
    If rng Is Nothing Then
        MsgBox "Operation Cancelled"
        Sheet1.Select
        Range("A1").Select
        Application.ScreenUpdating = True
        End
    Else
        rng.Select
        ActiveWorkbook.Names.Add Name:="data", RefersToR1C1:=rng
    End If
End Sub

Open in new window

Comment
Watch Question

ExcelGuideConsultant

Commented:
could you try to run the code again with the txt input but this time change     Dim x As Integer
 into     Dim x As String

Run and see what happens...

Author

Commented:
nope - sorry
ExcelGuideConsultant

Commented:
at which line do you get the error

Author

Commented:
                   Case xlEqual
                        If CDbl(rng.Value) = CDbl(FC.Formula1) Then
                            ActiveCondition = ndx
                            Exit Function
                        End If
ExcelGuideConsultant

Commented:
it is from this function: Function ActiveCondition(rng As Range) As Integer

clearly this code has been written for integers

try to make strings of those integers...like
Function ActiveCondition(rng As Range) As String

Im not sure this will work though but you are getting that error because rng.Value is expecting to be an integer when you try this with txt.
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014

Commented:
Hi, the error is because the CDbl function is trying to convert the value in each cell to a number.

So perhaps an IsNumeric check before doing anything with the value might help....

Rob.

Function ActiveCondition(rng As Range) As Integer
    'Chip Pearson http://www.cpearson.com/excel/CFColors.htm
    Dim ndx As Long
    Dim FC As FormatCondition
	
	If IsNumeric(rng.Value) = True Then
 
	    If rng.FormatConditions.Count = 0 Then
	        ActiveCondition = 0
	    Else
	    For ndx = 1 To rng.FormatConditions.Count
	        Set FC = rng.FormatConditions(ndx)
	        Select Case FC.Type
	            Case xlCellValue
	                Select Case FC.Operator
	                    Case xlBetween
	                        If CDbl(rng.Value) >= CDbl(FC.Formula1) And _
	                          CDbl(rng.Value) <= CDbl(FC.Formula2) Then
	                            ActiveCondition = ndx
	                            Exit Function
	                        End If
	                    Case xlGreater
	                        If CDbl(rng.Value) > CDbl(FC.Formula1) Then
	                            ActiveCondition = ndx
	                            Exit Function
	                        End If
	                    Case xlEqual
	                        If CDbl(rng.Value) = CDbl(FC.Formula1) Then
	                            ActiveCondition = ndx
	                            Exit Function
	                        End If
	                    Case xlGreaterEqual
	                        If CDbl(rng.Value) >= CDbl(FC.Formula1) Then
	                            ActiveCondition = ndx
	                            Exit Function
	                        End If
	                    Case xlLess
	                        If CDbl(rng.Value) < CDbl(FC.Formula1) Then
	                            ActiveCondition = ndx
	                            Exit Function
	                        End If
	                    Case xlLessEqual
	                        If CDbl(rng.Value) <= CDbl(FC.Formula1) Then
	                            ActiveCondition = ndx
	                            Exit Function
	                        End If
	                    Case xlNotEqual
	                        If CDbl(rng.Value) <> CDbl(FC.Formula1) Then
	                            ActiveCondition = ndx
	                            Exit Function
	                        End If
	                    Case xlNotBetween
	                        If CDbl(rng.Value) <= CDbl(FC.Formula1) Or _
	                            CDbl(rng.Value) >= CDbl(FC.Formula2) Then
	                            ActiveCondition = ndx
	                            Exit Function
	                        End If
	                    Case Else
	                        Debug.Print "UNKNOWN OPERATOR"
	                End Select
	            Case xlExpression
	                If Application.Evaluate(FC.Formula1) Then
	                    ActiveCondition = ndx
	                    Exit Function
	                End If
	            Case Else
	                Debug.Print "UNKNOWN TYPE"
	        End Select
	    Next ndx
	    End If
	End If
    ActiveCondition = 0
End Function

Open in new window

Author

Commented:
hi,
thanks for the help
the thing is that i want this to work for BOTH txt and numbers.
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014

Commented:
If you want to work with text, do you still want to use a numeric representation of that text?

If the text can not be represented as numeric, you will get a "Type Mismatch" error when using CDbl.  If you don't want a numeric representation of the text, then a line such as this:
If CDbl(rng.Value) >= CDbl(FC.Formula1) And

won't work with text.  In this case, what "calcualations" do you want to make with the text?  Can you provide an example of what text you might have in a cell?

Regards,

Rob.

Author

Commented:
the text could be just anything from "cat" to "dog"
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION

Author

Commented:
thanks!
CERTIFIED EXPERT
Most Valuable Expert 2012
Top Expert 2014

Commented:
No problem. Thanks for the grade.

Regards,

Rob.

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.