Input box with multiple events based on numerical value from another cell

rbahena

New Member
Joined
May 13, 2021
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
Cell B52 = 5

Cell B53 when selected launches Input box and presents user with 5 events/entries. The five entries will then be written to cell B53 in comma delimited format.

This should work from column B thru column T for row pair B52 to B53. However, perhaps the code can be assigned to different row pairs such as this scenario.

At the moment I have the following code working but only presents a single Input Box that applies only to row 53 and I know I have to do five entries separated by a comma but of course the number of entries not enforced which I think should be.

Dim xRtn As Variant
If Selection.Count = 1 Then
If (Target.Column >= 2 And Target.Column <= 20) And Target.Row = 53 Then
xRtn = Application.InputBox("Use a comma to separate your entries please", "Copper - Network Port(s) On Device")
If xRtn <> False Then Target.value = xRtn
End If
End If

Thank you for your assistance. Very much appreciated.

Regards,

Raul
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

HaHoBe

Well-known Member
Joined
Jan 24, 2003
Messages
513
Office Version
  1. 2013
Platform
  1. Windows
Hi Raul,

maybe like this, Code goes behind the sheet you want it to work on:
VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
  Dim xRtn As Variant
  Dim lngCounter As Long
  Dim strText As String
  
  If Selection.Count = 1 Then
    If (Target.Column >= 2 And Target.Column <= 20) And Target.Row = 53 Then
      If Target.Offset(-1, 0).Value <> "" And IsNumeric(Target.Offset(-1, 0)) Then
        For lngCounter = 1 To Target.Offset(-1, 0).Value
        xRtn = Application.InputBox("Your entriy please", "Copper - Network Port(s) On Device")
        If xRtn <> False Then
          strText = strText & xRtn & ", "
        Else
          Exit Sub
        End If
        Next lngCounter
      Target.Value = Left(strText, Len(strText) - 2)
      End If
    End If
  End If

End Sub
Ciao,
Holger
 

rbahena

New Member
Joined
May 13, 2021
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
Hi Raul,

maybe like this, Code goes behind the sheet you want it to work on:
VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
  Dim xRtn As Variant
  Dim lngCounter As Long
  Dim strText As String
 
  If Selection.Count = 1 Then
    If (Target.Column >= 2 And Target.Column <= 20) And Target.Row = 53 Then
      If Target.Offset(-1, 0).Value <> "" And IsNumeric(Target.Offset(-1, 0)) Then
        For lngCounter = 1 To Target.Offset(-1, 0).Value
        xRtn = Application.InputBox("Your entriy please", "Copper - Network Port(s) On Device")
        If xRtn <> False Then
          strText = strText & xRtn & ", "
        Else
          Exit Sub
        End If
        Next lngCounter
      Target.Value = Left(strText, Len(strText) - 2)
      End If
    End If
  End If

End Sub
Ciao,
Holger
Hola Holger,

You is the man!! Thank you so much for responding so quickly and with the solution I've been trying to figure out for better part of the day. I did add a line to the code to select next row. It works beautifully!!

Dim xRtn As Variant
Dim lngCounter As Long
Dim strText As String

If Selection.Count = 1 Then
If (Target.Column >= 2 And Target.Column <= 20) And Target.Row = 53 Then
If Target.Offset(-1, 0).value <> "" And IsNumeric(Target.Offset(-1, 0)) Then
For lngCounter = 1 To Target.Offset(-1, 0).value
xRtn = Application.InputBox("Your entriy please", "Copper - Network Port(s) On Device")
If xRtn <> False Then
strText = strText & xRtn & ", "
Else
Exit Sub
End If
Next lngCounter
Target.value = Left(strText, Len(strText) - 2)
ActiveCell.Offset(1, 0).Select
End If
End If

Regards,
Raul.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,836
Messages
5,766,720
Members
425,373
Latest member
ndiejennrrd

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