Problem with vba code

[Ciccio86]

Hi i have problem with this code. Can someone help me?
Im tryng to check if value on the left cell from checkbox in sheet "View" is in a table on another sheet called "List" and if his date is expired... but every time i have the same result.

Sub Listing()

Dim ViewSheet As Worksheet
Dim ListSheet As Worksheet
Dim ViewValue As Variant
Dim ValueFound As Boolean
Dim ValueExpired As Boolean
Dim chk As oleObject

Set ViewSheet = ThisWorkbook.Sheets("View")
Set ListSheet = ThisWorkbook.Sheets("List")

If TypeName(chk) = "CheckBox" Then
ViewValue = ViewSheet.Cells(chk.TopLeftCell.Offset(0, -1)).value

ValueFound = False
ValueExpired = False

For i = 1 To ListSheet.Range("A1").End(xlDown).Row
If ListSheet.Range("B" & i).value = ViewValue Then
ValueFound = True
If ListSheet.Range("C" & i).value < Date Then
ValueExpired = True
Else
ValueExpired = False
End If
End If
Next i
End If

If ValueFound = True And ValueExpired = False Then
chk.TopLeftCell.Offset(0, 1)).value = "OK"
Else
MsgBox "Not in the List"
chk.Object = False
chk.TopLeftCell.Offset(0, 1)).value = "NOT OK"
End If

End Sub

 

[Ciccio86]

That is a different issue.
Try the below but i if doesn't work you can log it as a seperate thread.

Where you have the click event put the below, make sure you include the Public line at the top.

Public runChkBox As Boolean

Private Sub CheckBox1_Click()
    Dim chk As OLEObject
    Set chk = Me.OLEObjects(CheckBox1.Name)
    If runChkBox Then
        runChkBox = False
        Exit Sub
    End If
   
    If Listing(chk) = "Not Found" Then
        runChkBox = True
        chk.Object = False
    End If

End Sub

I have changed the Listing Sub to a function so replace it with this.

Function Listing(chk As OLEObject)

Dim ViewSheet As Worksheet
Dim ListSheet As Worksheet
Dim ViewValue As Variant
Dim ValueFound As Boolean
Dim ValueExpired As Boolean
Dim i As Long

    Set ViewSheet = ThisWorkbook.Sheets("View")
    Set ListSheet = ThisWorkbook.Sheets("List")
   
    If TypeName(chk.Object) = "CheckBox" Then
        ViewValue = chk.TopLeftCell.Offset(0, -1).Value
       
        ValueFound = False
        ValueExpired = False
       
        For i = 1 To ListSheet.Range("A1").End(xlDown).Row
            If ListSheet.Range("B" & i).Value = ViewValue Then
                ValueFound = True
                If ListSheet.Range("C" & i).Value < Date Then
                    ValueExpired = True
                Else
                    ValueExpired = False
                End If
            End If
        Next i
    End If
   
    If ValueFound = True And ValueExpired = False Then
        chk.TopLeftCell.Offset(0, 1).Value = "OK"
    Else
        MsgBox "Not in the List"
        Listing = "Not Found"
        chk.TopLeftCell.Offset(0, 1).Value = "NOT OK"
    End If

End Function

Thanks

 

[Alex Blakenburg]

You're welcome.
I would be interested to know if my post # then 10 fixes the issue of the code changing the checkbox calling the click event up again and effectively running the code a 2nd time.
If it doesn't and you open a new thread for that issue drop the link here and I will have a look to see what others come up with.

 

[Ciccio86]

You're welcome.
I would be interested to know if my post # then 10 fixes the issue of the code changing the checkbox calling the click event up again and effectively running the code a 2nd time.
If it doesn't and you open a new thread for that issue drop the link here and I will have a look to see what others come up with.

Yes it fix

 

[Alex Blakenburg]

Thanks for letting me know.