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

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,343
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

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,871
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
shouldn't it be
Rich (BB code):
Me.ListObjects("CSS_Quote").ListColumns(5).Range = 3
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,343
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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.
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,343
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,343
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

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
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,871
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
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
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,343
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

But if I remove the comment, I get the error End if without block if and the very last end if is highlighted.
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,343
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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.
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,871
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Did you look at the move shape code I posted in the other thread ???
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,343
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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
 

Forum statistics

Threads
1,140,917
Messages
5,703,168
Members
421,279
Latest member
emzy

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
Top