Help modifying InputBox code to work with 2 Ranges

grady121

Active Member
Joined
May 27, 2005
Messages
385
Office Version
  1. 2016
Platform
  1. Windows
Not having used an InputBox before, I have been given a code that uses one to add players scores into a single Range (Range 1).

The List of players names, starting at ("B10") and downwards, are presented one at a time into the InputBox with the scores entered into the corresponding cells starting at ("J10") downwards until the names stop. There may be Blanks involved.

What I would like to do is fill in another range (Range 2) starting at ("AK10") downwards at the same time as Range 1 is filled in.

Can anyone modify my existing part of code below, to achieve my aim.

Code:
 Dim ListRow As Integer, ListColumn As Integer, NewDataColumn As Integer
 Dim MyNewData As String
 Dim iRet As Integer
 
 MyNewData = "x"    ' Dummy value to keep loop alive
 
    Do Until MyNewData = ""
    ActiveWindow.ScrollRow = 9
 
    ListRow = 10: ListColumn = 2: NewDataColumn = 10
While Sheets(1).Cells(ListRow, ListColumn) <> ""
     MyNewData = InputBox("Enter the Details for:- " & vbNewLine & vbNewLine & Sheets(1).Cells(ListRow, ListColumn), _
                 "Add Scores", Sheets(1).Cells(ListRow, NewDataColumn)) 'Get input
     If MyNewData <> "" Then Sheets(1).Cells(ListRow, NewDataColumn) = MyNewData  'If input is not empty, use the input
     ListRow = ListRow + 1
   
Wend

' On to the next part of code

Thanks in advance.
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
if you want the same value in AK as in B then:
Code:
Dim ListRow As Integer, ListColumn As Integer, NewDataColumn As Integer
Dim MyNewData As String
Dim iRet As Integer

MyNewData = "x"    ' Dummy value to keep loop alive

Do Until MyNewData = ""
    ActiveWindow.ScrollRow = 9

    ListRow = 10: ListColumn = 2: NewDataColumn = 10[COLOR=Red]: NewDataColumn2 = 37[/COLOR]
    While ActiveSheet.Cells(ListRow, ListColumn) <> ""
        MyNewData = InputBox("Enter the Details for:- " & vbNewLine & vbNewLine & ActiveSheet.Cells(ListRow, ListColumn), _
                             "Add Scores", ActiveSheet.Cells(ListRow, NewDataColumn))    'Get input
        If MyNewData <> "" Then [COLOR=Red]'new line here[/COLOR]
            ActiveSheet.Cells(ListRow, NewDataColumn) = MyNewData  'If input is not empty, use the input
            [COLOR=Red]ActiveSheet.Cells(ListRow, NewDataColumn[B]2[/B]) = MyNewData
        End If[/COLOR]
        ListRow = ListRow + 1
    Wend
 
Upvote 0
Thanks p45cal

Works great.

I can now see the logic, I just couldn't see the wood before !

Many thanks for a quick response.
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,106
Members
452,302
Latest member
TaMere

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