If certain criteria is met, I need a 3 entered in the column E for the row and a message box to appear.

D

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,352
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have an excel table and I am trying to make a value in column E for any row be 3 if these conditions are met
  • If anything lower then 3 is entered in column E
  • If the value in column B for that row is any of these values
    • Supervised Contact
    • Supervised Transport
    • Daytime Respite
I then want a message box to appear informing the user that the minimum charge for that service is 3 hours.


This is my code in the worksheet_change event for the worksheet that has the table I tried to write for the first item in the list but it wouldn't work.
VBA Code: 
        If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(2).Range) = "Supervised Contact" Then
            If Me.ListObjects("CSS_Quote").ListColumns(5).Range < 3 Then
                MsgBox "The minimum hourly charge for a Supervised Contact is 3 hours"
                Me.ListObjects("CSS_Quote").ListColumns(5) = 3
            End If
        End If

I get an error Wrong number of arguments or invalid property assignment with the following line highlighted
VBA Code: 
.ListColumns(5) =


This is part of a larger section of code
VBA Code: 
    If Selection.Count = 1 Then
        If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(6).Range) > 1 Then
            If Selection.Count = 1 Then
                cars = InputBox("Please enter how many cars are required.")
                    If cars > 1 Then
                    Cells(Target.Row, "L") = cars
            Else
                    Cells(Target.Row, "L") = 1
                End If
            End If
        Else
            If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(6).Range) = 1 Then
                Cells(Target.Row, "L") = 1
            End If
        End If
        If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(2).Range) = "Supervised Contact" Then
            If Me.ListObjects("CSS_Quote").ListColumns(5).Range < 3 Then
                MsgBox "The minimum hourly charge for a Supervised Contact is 3 hours"
                Me.ListObjects("CSS_Quote").ListColumns(5) = 3
            End If
        End If
       
    End If

Could someone show me what have I done wrong with my code and help me with the rest of the code please?
 
Last edited:

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
shouldn't it be
Rich (BB code): 
Me.ListObjects("CSS_Quote").ListColumns(5).Range = 3
 
Upvote 0
I tried that and changed my code around a little and now I don't get an error, but I don't get the 3 to appear in the cell or the msgbox to appear.

VBA Code: 
    If Selection.Count = 1 Then
        If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(6).Range) > 1 Then
            If Selection.Count = 1 Then
                cars = InputBox("Please enter how many cars are required.")
                    If cars > 1 Then
                    Cells(Target.Row, "L") = cars
            Else
                    Cells(Target.Row, "L") = 1
                End If
            End If
        Else
            If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(6).Range) = 1 Then
                Cells(Target.Row, "L") = 1
            End If
        End If
        If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(2).Range) = "Supervised Contact" Then
            If Me.ListObjects("CSS_Quote").ListColumns(5).Range < 3 Then
                MsgBox "The minimum hourly charge for a Supervised Contact is 3 hours"
                Me.ListObjects("CSS_Quote").ListColumns(5).Range = 3
            End If
        End If
        
    End If


I step through my code and when it gets to this line,
VBA Code: 
If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(6).Range) > 1 Then

the following code in the if statement is skipped so that line is not true but it does work for if I enter more than 1 in column F for finding out how many cars are needed.
 
Upvote 0
I had it partially working but then I got the error Block if without end if.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Quoting.Unprotect Password:=ToUnlock
      Dim ans As String, cars As Integer
    
    'code to enter allow organisation to be entered if other is selected
        If Not Intersect(Target, Me.Range("B7")) Is Nothing Then
            If LCase(Me.Range("B7").Value) = "other" Then
                ans = InputBox("Please enter organisation.", , Me.Range("B7").Value)
                If ans <> "" Then
                    Range("B7").Value = ans
                End If
            End If
        End If
    
        'If Selection.Count = 1 Then
     
            'If Not Intersect(Target, Range("B7")) Is Nothing Then
           '     Workbooks.Open ThisWorkbook.Path & "\" & "Client_list.xlsm"
           ' End If
        'End If
      If Target.Count > 1 Or IsEmpty(Target) Then Exit Sub
      '
      'On Error GoTo App_Events
      If Not Intersect(Target, Range("A:A,B:B")) Is Nothing Then
            
        Select Case Target.Column
            Case 1
                If Target.Value < Date Then
                    If MsgBox("This input is older than today. Are you sure that is what you want?", vbYesNo) = vbNo Then
                        Target.Value = ""
                    End If
                End If
            Case 2
                If LCase(Target.Value) = LCase("Activities") Then
                    Do
                        ans = InputBox("Please enter the Activities cost." & _
                        vbCrLf & "************************************" & vbCrLf & _
                        "To change an activity cost, select Activities from the Service list again.")
                            If ans <> "" Then
                                Cells(Target.Row, "M") = ans
                    Exit Do
                            Else
                                MsgBox ("You must enter a Activities cost.")
                            End If
                    Loop
                End If
        End Select
      End If
      
    If Selection.Count = 1 Then
        If Cells(Target.Row, "E") < 3 Then
            If Cells(Target.Row, "B") = "Supervised Contact" Then
               MsgBox "The minimum hourly charge for a Supervised Contact is 3 hours"
               Cells(Target.Row, "E") = 3
            End If
        End If

    End If
    
    If Selection.Count = 1 Then
        If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(6).Range) > 1 Then
            If Selection.Count = 1 Then
                cars = InputBox("Please enter how many cars are required.")
                    If cars > 1 Then
                    Cells(Target.Row, "L") = cars
            Else
                    Cells(Target.Row, "L") = 1
                    End If
            End If
        Else
            If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(6).Range) = 1 Then
                Cells(Target.Row, "L") = 1
            End If
        End If
        
    'End If
    


'    If Selection.Count = 1 Then
'        If Not Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(1).Range) Is Nothing Then
'            MsgBox "hello"
'
'        End If
   ' End If

App_Events:
    Application.EnableEvents = True
    Quoting.Protect Password:=ToUnlock
End Sub
 
Upvote 0
Now I got that bit working but one of the other parts have stopped working. Now when I try and enter a value under 3 in column E, I get the message box specified, the value is changed to 3 but then I get an error Object variable or with block variable not set with the following line highlighted
VBA Code: 
If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(6).Range) > 1 Then

Here is my whole sub
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Quoting.Unprotect Password:=ToUnlock
      Dim ans As String, cars As Integer
    
    'code to enter allow organisation to be entered if other is selected
        If Not Intersect(Target, Me.Range("B7")) Is Nothing Then
            If LCase(Me.Range("B7").Value) = "other" Then
                ans = InputBox("Please enter organisation.", , Me.Range("B7").Value)
                If ans <> "" Then
                    Range("B7").Value = ans
                End If
            End If
        End If
    
        'If Selection.Count = 1 Then
     
            'If Not Intersect(Target, Range("B7")) Is Nothing Then
           '     Workbooks.Open ThisWorkbook.Path & "\" & "Client_list.xlsm"
           ' End If
        'End If
      If Target.Count > 1 Or IsEmpty(Target) Then Exit Sub
      '
      'On Error GoTo App_Events
      If Not Intersect(Target, Range("A:A,B:B")) Is Nothing Then
            
        Select Case Target.Column
            Case 1
                If Target.Value < Date Then
                    If MsgBox("This input is older than today. Are you sure that is what you want?", vbYesNo) = vbNo Then
                        Target.Value = ""
                    End If
                End If
            Case 2
                If LCase(Target.Value) = LCase("Activities") Then
                    Do
                        ans = InputBox("Please enter the Activities cost." & _
                        vbCrLf & "************************************" & vbCrLf & _
                        "To change an activity cost, select Activities from the Service list again.")
                            If ans <> "" Then
                                Cells(Target.Row, "M") = ans
                    Exit Do
                            Else
                                MsgBox ("You must enter a Activities cost.")
                            End If
                    Loop
                End If
        End Select
      End If
      
    If Selection.Count = 1 Then
        If Cells(Target.Row, "E") < 3 Then
            If Cells(Target.Row, "B") = "Supervised Contact" Then
               MsgBox "The minimum hourly charge for a Supervised Contact is 3 hours"
               Cells(Target.Row, "E") = 3
            End If
        End If
    'End If
    If Selection.Count = 1 Then
        If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(6).Range) > 1 Then
            If Selection.Count = 1 Then
                cars = InputBox("Please enter how many cars are required.")
                    If cars > 1 Then
                    Cells(Target.Row, "L") = cars
            Else
                    Cells(Target.Row, "L") = 1
                    End If
            End If
        Else
            If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(6).Range) = 1 Then
                Cells(Target.Row, "L") = 1
            End If
        End If
    End If
    
'    If Selection.Count = 1 Then
'        If Not Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(1).Range) Is Nothing Then
'            MsgBox "hello"
'
'        End If
    End If

App_Events:
    Application.EnableEvents = True
    Quoting.Protect Password:=ToUnlock
End Sub
 
Upvote 0
your last End If is commented out here...
VBA Code: 
If Selection.Count = 1 Then
        If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(6).Range) > 1 Then
            If Selection.Count = 1 Then
                cars = InputBox("Please enter how many cars are required.")
                    If cars > 1 Then
                    Cells(Target.Row, "L") = cars
            Else
                    Cells(Target.Row, "L") = 1
                    End If
            End If
        Else
            If Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(6).Range) = 1 Then
                Cells(Target.Row, "L") = 1
            End If
        End If
        
    'End If
 
Upvote 0
But if I remove the comment, I get the error End if without block if and the very last end if is highlighted.
 
Upvote 0
From memory I think there was some error that required me to have an escape clause if there is an error so I removed the comment next to
VBA Code: 
On Error GoTo App_Events

..and that bit seems to work fine now.
 
Upvote 0
Did you look at the move shape code I posted in the other thread ???
 
Upvote 0
Not yet, I can't concentrate on more than 1 thing at a time but I will get to it, thanks for that.

I just remembered, is this how I specify those extra services that apply to the issue we have been talking about?
VBA Code: 
    If Selection.Count = 1 Then
        If Cells(Target.Row, "E") < 3 Then
            If Cells(Target.Row, "B") = "Supervised Contact" Or Cells(Target.Row, "B") = "Supervised Transport" Or Cells(Target.Row, "B") = "Daytime Respite" Then
               MsgBox "The minimum hourly charge for a Supervised Contact is 3 hours"
               Cells(Target.Row, "E") = 3
            End If
        End If
    End If
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Need to have Worksheet_Change event include value from another column using structured reference
Replies
4
Views
303
Alex Blakenburg
A
S
  • Solved
Need value to be the Table Column Header in lieu of Cell Address
Replies
1
Views
276
sspatriots
S
F
  • Question
VBA to copy and insert a row below only if a certain criteria is met
Replies
2
Views
48
feni1388
F
E
  • Question
VB Help with code to copy selected rows to specified cells in another sheet.
2
Replies
12
Views
396
Excel_Assis
E
D
  • Solved
If a number>1 is entered, I need an input box to appear and enter the answer in a cell
2
Replies
14
Views
932
dpaton05
D

Forum statistics

Threads
1,214,979
Messages
6,122,550
Members
449,088
Latest member
davidcom

Share this page

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