Type Mismatch Error

[sharky12345]

I've suddenly started getting an Error 13 - Type Mismatch on this code, which is odd because it's worked fine for weeks;

Private Sub Worksheet_Activate()
    Dim ThisCell2 As Range
    Range("K2").Formula = "=TODAY()"
    Range("K4:K44").ClearContents
    For Each cell In Range("J4:J44")
        If cell = "" Then
            cell.Offset(0, 1).Value = ""
        End If
        For Each ThisCell2 In Sheet2.Range("J2:J8")
            If InStr(cell.Value, ThisCell2.Value) <> 0 Then
                cell.Offset(0, 1).Value = "Available"
            End If
        Next ThisCell2
        For Each ThisCell2 In Sheet2.Range("K2:K21")
            If InStr(cell.Value, ThisCell2.Value) <> 0 Then
                cell.Offset(0, 1).Value = "Unavailable"
            End If
        Next ThisCell2
    Next
    For Each cell In Range("J4:J44")
        If cell.Offset(0, 1) = "" Then
            Set FoundRange = Sheet2.Range("J2:K22").Find(what:=cell, LookIn:=xlFormulas, lookat:=xlWhole)
            If FoundRange Is Nothing Then
                cell.Offset(0, 1) = "Unavailable"
            End If
        End If
    Next
End Sub

It's failing on the following lines;

If cell = "" Then

and

If InStr(cell.Value, ThisCell2.Value) <> 0 Then

Can anyone offer an explanation and ideally a solution?

 

[RoryA]

Most likely cause would be an error in one of the cells you are processing. Test first using

If Not IsError(cell.value) then

 

[sharky12345]

Thanks Rory - tried that, same issue I'm afraid.

 

[RoryA]

How and where did you try that?

 

[sharky12345]

I added this;

If Not IsError(cell.value) then

before my original code then added

End If

afterwards...this is on the worksheet activate event.

 

[RoryA]

Where specifically, please?

 

[sharky12345]

Like this;

Private Sub Worksheet_Activate()
    Dim ThisCell2 As Range
    Range("K2").Formula = "=TODAY()"
    Range("K4:K44").ClearContents
    If Not IsError(cell.Value) Then
        For Each cell In Range("J4:J44")
            If cell = "" Then
                cell.Offset(0, 1).Value = ""
            End If
            For Each ThisCell2 In Sheet2.Range("J2:J8")
                If InStr(cell.Value, ThisCell2.Value) <> 0 Then
                    cell.Offset(0, 1).Value = "Available"
                End If
            Next ThisCell2
            For Each ThisCell2 In Sheet2.Range("K2:K21")
                If InStr(cell.Value, ThisCell2.Value) <> 0 Then
                    cell.Offset(0, 1).Value = "Unavailable"
                End If
            Next ThisCell2
        Next
        For Each cell In Range("J4:J44")
            If cell.Offset(0, 1) = "" Then
                Set FoundRange = Sheet2.Range("J2:K22").Find(what:=cell, LookIn:=xlFormulas, lookat:=xlWhole)
                If FoundRange Is Nothing Then
                    cell.Offset(0, 1) = "Unavailable"
                End If
            End If
        Next
    End If
End Sub

 

[RoryA]

You should get an error doing that as cell hasn't been initialised if you put it before the loop. It needs to be:

Private Sub Worksheet_Activate()
    Dim ThisCell2 As Range
    Range("K2").Formula = "=TODAY()"
    Range("K4:K44").ClearContents

        For Each cell In Range("J4:J44")
          If Not IsError(cell.Value) Then
            If cell = "" Then
                cell.Offset(0, 1).Value = ""
            End If
            For Each ThisCell2 In Sheet2.Range("J2:J8")
                If InStr(cell.Value, ThisCell2.Value) <> 0 Then
                    cell.Offset(0, 1).Value = "Available"
                End If
            Next ThisCell2
            For Each ThisCell2 In Sheet2.Range("K2:K21")
                If InStr(cell.Value, ThisCell2.Value) <> 0 Then
                    cell.Offset(0, 1).Value = "Unavailable"
                End If
            Next ThisCell2
          End If
        Next
        For Each cell In Range("J4:J44")
          If Not IsError(cell.Value) Then
            If cell.Offset(0, 1) = "" Then
                Set FoundRange = Sheet2.Range("J2:K22").Find(what:=cell, LookIn:=xlFormulas, lookat:=xlWhole)
                If FoundRange Is Nothing Then
                    cell.Offset(0, 1) = "Unavailable"
                End If
            End If
          End If
        Next

End Sub

 

[sharky12345]

Ahh, thanks Rory - will give that a go.

 

[sharky12345]

Works a treat now - thanks!