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

D

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,352
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
 
Sort by date Sort by votes
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
 
Upvote 0

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
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
 
Upvote 0
Do you mean to place that code instead of the Do loop?
 
Upvote 0
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
 
Upvote 0
Not sure what has happened but it is working as intended now, not sure what has changed (y)
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
Format & Protect range of cells using VBA
Replies
7
Views
259
Gajendran Yadhav
G
A
  • Question
I need your help with that
Replies
0
Views
203
Aljuhahs
A
A
  • Question
I need yur help with VBA
Replies
0
Views
222
Aljuhahs
A
S
  • Question
Need code that adds multiple new rows to table to include a check box in column "L" for each new row
Replies
0
Views
312
sspatriots
S
A
  • Question
After User Enters A Value (Validation List), Not Automatically Advancing To Next Cell As Per "Select"
Replies
1
Views
166
Ark68
A

Forum statistics

Threads
1,214,611
Messages
6,120,509
Members
448,967
Latest member
screechyboy79

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