Problem with vba code

Ciccio86

New Member
Joined
Feb 3, 2023
Messages
27
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
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

Cattura.JPG
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
I see there are extra paraenthases in chk.TopLeftCell.Offset(0,1)).Value statement. What happens if you remove them?
 
Upvote 0
I see there are extra paraenthases in chk.TopLeftCell.Offset(0,1)).Value statement. What happens if you remove them?
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

I removed but now i have error "Need an object"
 
Upvote 0
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

I removed but now i have error "Need an objecL
Where does the program terminate with error?
 
Upvote 0
I don't know where you are assigning chk but try this:
It incorporates @Skyybot's change.

Oops I tested it with the Chk object being passed in since I couldn't see where you assigned it

Rich (BB code):
Sub 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 chk As OLEObject
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"
        chk.Object = False
        chk.TopLeftCell.Offset(0, 1).Value = "NOT OK"
    End If

End Sub
 
Last edited:
Upvote 0
Solution
I don't know where you are assigning chk but try this:
It incorporates @Skyybot's change.

Oops I tested it with the Chk object being passed in since I couldn't see where you assigned it

Rich (BB code):
Sub 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 chk As OLEObject
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"
        chk.Object = False
        chk.TopLeftCell.Offset(0, 1).Value = "NOT OK"
    End If

End Sub
When i try to call this sub from a checkbox i got compile error "Argument not Optional"

Private Sub CheckBox1_Click()
Listing
End Sub
 
Upvote 0
I used this:
VBA Code:
Private Sub CheckBox1_Click()
    Dim chk As OLEObject
    Set chk = Me.OLEObjects(CheckBox1.Name)
    Call Listing(chk)
End Sub
 
Upvote 0
I used this:
VBA Code:
Private Sub CheckBox1_Click()
    Dim chk As OLEObject
    Set chk = Me.OLEObjects(CheckBox1.Name)
    Call Listing(chk)
End Sub
Ok now work, thanks :D
But now i have the msgbox popping twice on checkbox state change
 
Upvote 0
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.
VBA Code:
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.
VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,215,737
Messages
6,126,571
Members
449,318
Latest member
Son Raphon

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top