If a number>1 is entered, I need an input box to appear and enter the answer in a cell

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,209
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have a table on my spreadsheet called css_quote that records information about jobs, where column F records the staff required. If anything is entered in this cell that is greater then 1, I need an input box to appear asking how many cars are needed. I then need this number put into column L for the row.

This is my worksheet_change event for the sheet that has the table. Can someone help me with the vba to achieve the above please?

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Quoting.Unprotect Password:=ToUnlock
      Dim ans As String
    
    '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 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,209
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Just found a problem with this Michael:

  • If I enter 2 in column F, I get asked how many cars are needed
    • if I enter 1 in the input box, it enters a repetitive loop of asking the same question over and over.
What is wrong with my code
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 Intersect(Target, Me.ListObjects("CSS_Quote").ListColumns(6).Range) > 1 Then
            Do
                cars = InputBox("Please enter how many cars are required.")
                    If cars > 1 Then
                        Cells(Target.Row, "L") = cars
                        Exit Do
                    Else
                        Cells(Target.Row, "L") = 1
                    End If
            Loop
        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
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,164
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Why Have a Do Loop?
MAybe this instead
VBA Code:
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
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,209
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Do you mean to place that code instead of the Do loop?
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,209
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I tried to replace the do loop with your suggestions but now it won't even ask me how many cars are required.

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 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,209
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Not sure what has happened but it is working as intended now, not sure what has changed (y)
 

Watch MrExcel Video

Forum statistics

Threads
1,129,816
Messages
5,638,496
Members
417,029
Latest member
lingx86

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